Theory Auxiliary
chapter ‹ Jinja Source Language \label{cha:j} ›
section ‹ Auxiliary Definitions ›
theory Auxiliary imports Main begin
lemma nat_add_max_le[simp]:
"((n::nat) + max i j ≤ m) = (n + i ≤ m ∧ n + j ≤ m)"
by arith
lemma Suc_add_max_le[simp]:
"(Suc(n + max i j) ≤ m) = (Suc(n + i) ≤ m ∧ Suc(n + j) ≤ m)"
by arith
notation Some ("(⌊_⌋)")
declare
option.splits[split]
Let_def[simp]
subset_insertI2 [simp]
Cons_eq_map_conv [iff]
subsection ‹@{text distinct_fst}›
definition distinct_fst :: "('a × 'b) list ⇒ bool"
where
"distinct_fst ≡ distinct ∘ map fst"
lemma distinct_fst_Nil [simp]:
"distinct_fst []"
by (unfold distinct_fst_def) (simp (no_asm))
lemma distinct_fst_Cons [simp]:
"distinct_fst ((k,x)#kxs) = (distinct_fst kxs ∧ (∀y. (k,y) ∉ set kxs))"
by (unfold distinct_fst_def) (auto simp:image_def)
lemma distinct_fst_appendD:
"distinct_fst(kxs @ kxs') ⟹ distinct_fst kxs ∧ distinct_fst kxs'"
by(induct kxs, auto)
lemma map_of_SomeI:
"⟦ distinct_fst kxs; (k,x) ∈ set kxs ⟧ ⟹ map_of kxs k = Some x"
by (induct kxs) (auto simp:fun_upd_apply)
subsection ‹ Using @{term list_all2} for relations ›
definition fun_of :: "('a × 'b) set ⇒ 'a ⇒ 'b ⇒ bool"
where
"fun_of S ≡ λx y. (x,y) ∈ S"
text ‹ Convenience lemmas ›
declare fun_of_def [simp]
lemma rel_list_all2_Cons [iff]:
"list_all2 (fun_of S) (x#xs) (y#ys) =
((x,y) ∈ S ∧ list_all2 (fun_of S) xs ys)"
by simp
lemma rel_list_all2_Cons1:
"list_all2 (fun_of S) (x#xs) ys =
(∃z zs. ys = z#zs ∧ (x,z) ∈ S ∧ list_all2 (fun_of S) xs zs)"
by (cases ys) auto
lemma rel_list_all2_Cons2:
"list_all2 (fun_of S) xs (y#ys) =
(∃z zs. xs = z#zs ∧ (z,y) ∈ S ∧ list_all2 (fun_of S) zs ys)"
by (cases xs) auto
lemma rel_list_all2_refl:
"(⋀x. (x,x) ∈ S) ⟹ list_all2 (fun_of S) xs xs"
by (simp add: list_all2_refl)
lemma rel_list_all2_antisym:
"⟦ (⋀x y. ⟦(x,y) ∈ S; (y,x) ∈ T⟧ ⟹ x = y);
list_all2 (fun_of S) xs ys; list_all2 (fun_of T) ys xs ⟧ ⟹ xs = ys"
by (rule list_all2_antisym) auto
lemma rel_list_all2_trans:
"⟦ ⋀a b c. ⟦(a,b) ∈ R; (b,c) ∈ S⟧ ⟹ (a,c) ∈ T;
list_all2 (fun_of R) as bs; list_all2 (fun_of S) bs cs⟧
⟹ list_all2 (fun_of T) as cs"
by (rule list_all2_trans) auto
lemma rel_list_all2_update_cong:
"⟦ i<size xs; list_all2 (fun_of S) xs ys; (x,y) ∈ S ⟧
⟹ list_all2 (fun_of S) (xs[i:=x]) (ys[i:=y])"
by (simp add: list_all2_update_cong)
lemma rel_list_all2_nthD:
"⟦ list_all2 (fun_of S) xs ys; p < size xs ⟧ ⟹ (xs!p,ys!p) ∈ S"
by (drule list_all2_nthD) auto
lemma rel_list_all2I:
"⟦ length a = length b; ⋀n. n < length a ⟹ (a!n,b!n) ∈ S ⟧ ⟹ list_all2 (fun_of S) a b"
by (erule list_all2_all_nthI) simp
declare fun_of_def [simp del]
subsection ‹ Auxiliary properties of @{text "map_of"} function ›
lemma map_of_set_pcs_notin: "C ∉ (λt. snd (fst t)) ` set FDTs ⟹ map_of FDTs (F, C) = None"
by (metis image_eqI image_image map_of_eq_None_iff snd_conv)
lemma map_of_insertmap_SomeD':
"map_of fs F = Some y ⟹ map_of (map (λ(F, y). (F, D, y)) fs) F = Some(D,y)"
by (induct fs) (auto simp:fun_upd_apply split: if_split_asm)
lemma map_of_reinsert_neq_None:
"Ca ≠ D ⟹ map_of (map (λ(F, y). ((F, Ca), y)) fs) (F, D) = None"
by (induct fs) (auto simp:fun_upd_apply split: if_split_asm)
lemma map_of_remap_insertmap:
"map_of (map ((λ((F, D), b, T). (F, D, b, T)) ∘ (λ(F, y). ((F, D), y))) fs)
= map_of (map (λ(F, y). (F, D, y)) fs)"
by (induct fs) (auto simp:fun_upd_apply split: if_split_asm)
lemma map_of_reinsert_SomeD:
"map_of (map (λ(F, y). ((F, D), y)) fs) (F, D) = Some T ⟹ map_of fs F = Some T"
by (induct fs) (auto simp:fun_upd_apply split: if_split_asm)
lemma map_of_filtered_SomeD:
"map_of fs (F,D) = Some (a, T) ⟹ Q ((F,D),a,T) ⟹
map_of (map (λ((F,D), b, T). ((F,D), P T)) (filter Q fs))
(F,D) = Some (P T)"
by (induct fs) (auto simp:fun_upd_apply split: if_split_asm)
lemma map_of_remove_filtered_SomeD:
"map_of fs (F,C) = Some (a, T) ⟹ Q ((F,C),a,T) ⟹
map_of (map (λ((F,D), b, T). (F, P T)) [((F, D), b, T)←fs . Q ((F, D), b, T) ∧ D = C])
F = Some (P T)"
by (induct fs) (auto simp:fun_upd_apply split: if_split_asm)
lemma map_of_Some_None_split:
assumes "t = map (λ(F, y). ((F, C), y)) fs @ t'" "map_of t' (F, C) = None" "map_of t (F, C) = Some y"
shows "map_of (map (λ((F, D), b, T). (F, D, b, T)) t) F = Some (C, y)"
proof -
have "map_of (map (λ(F, y). ((F, C), y)) fs) (F, C) = Some y" using assms by auto
then have "∀p. map_of fs F = Some p ∨ Some y ≠ Some p"
by (metis map_of_reinsert_SomeD)
then have "∀f b p pa. ((f ++ map_of (map (λ(a, p). (a, b::'b, p)) fs)) F = Some p ∨ Some (b, pa) ≠ Some p)
∨ Some y ≠ Some pa"
by (metis (no_types) map_add_find_right map_of_insertmap_SomeD')
then have "(map_of (map (λ((a, b), c, d). (a, b, c, d)) t')
++ map_of (map (λ(a, p). (a, C, p)) fs)) F = Some (C, y)"
by blast
then have "(map_of (map (λ((a, b), c, d). (a, b, c, d)) t')
++ map_of (map ((λ((a, b), c, d). (a, b, c, d)) ∘ (λ(a, y). ((a, C), y))) fs)) F = Some (C, y)"
by (simp add: map_of_remap_insertmap)
then show ?thesis using assms by auto
qed
end
Theory Type
section ‹ Jinja types ›
theory Type imports Auxiliary begin
type_synonym cname = string
type_synonym mname = string
type_synonym vname = string
definition Object :: cname
where
"Object ≡ ''Object''"
definition this :: vname
where
"this ≡ ''this''"
definition clinit :: "string" where "clinit = ''<clinit>''"
definition init :: "string" where "init = ''<init>''"
definition start_m :: "string" where "start_m = ''<start>''"
definition Start :: "string" where "Start = ''<Start>''"
lemma start_m_neq_clinit [simp]: "start_m ≠ clinit" by(simp add: start_m_def clinit_def)
lemma Object_neq_Start [simp]: "Object ≠ Start" by(simp add: Object_def Start_def)
lemma Start_neq_Object [simp]: "Start ≠ Object" by(simp add: Object_def Start_def)
datatype staticb = Static | NonStatic
datatype ty
= Void
| Boolean
| Integer
| NT
| Class cname
definition is_refT :: "ty ⇒ bool"
where
"is_refT T ≡ T = NT ∨ (∃C. T = Class C)"
lemma [iff]: "is_refT NT"
by(simp add:is_refT_def)
lemma [iff]: "is_refT(Class C)"
by(simp add:is_refT_def)
lemma refTE:
"⟦is_refT T; T = NT ⟹ P; ⋀C. T = Class C ⟹ P ⟧ ⟹ P"
by (auto simp add: is_refT_def)
lemma not_refTE:
"⟦ ¬is_refT T; T = Void ∨ T = Boolean ∨ T = Integer ⟹ P ⟧ ⟹ P"
by (cases T, auto simp add: is_refT_def)
end
Theory Decl
section ‹ Class Declarations and Programs ›
theory Decl imports Type begin
type_synonym
fdecl = "vname × staticb × ty"
type_synonym
'm mdecl = "mname × staticb × ty list × ty × 'm"
type_synonym
'm "class" = "cname × fdecl list × 'm mdecl list"
type_synonym
'm cdecl = "cname × 'm class"
type_synonym
'm prog = "'m cdecl list"
translations
(type) "fdecl" <= (type) "char list × staticb × ty"
(type) "'c mdecl" <= (type) "char list × staticb × ty list × ty × 'c"
(type) "'c class" <= (type) "char list × fdecl list × ('c mdecl) list"
(type) "'c cdecl" <= (type) "char list × ('c class)"
(type) "'c prog" <= (type) "('c cdecl) list"
definition "class" :: "'m prog ⇒ cname ⇀ 'm class"
where
"class ≡ map_of"
lemma class_cons: "⟦ C ≠ fst x ⟧ ⟹ class (x # P) C = class P C"
by (simp add: class_def)
definition is_class :: "'m prog ⇒ cname ⇒ bool"
where
"is_class P C ≡ class P C ≠ None"
lemma finite_is_class: "finite {C. is_class P C}"
proof -
have "{C. is_class P C} = dom (map_of P)"
by (simp add: is_class_def class_def dom_def)
thus ?thesis by (simp add: finite_dom_map_of)
qed
definition is_type :: "'m prog ⇒ ty ⇒ bool"
where
"is_type P T ≡
(case T of Void ⇒ True | Boolean ⇒ True | Integer ⇒ True | NT ⇒ True
| Class C ⇒ is_class P C)"
lemma is_type_simps [simp]:
"is_type P Void ∧ is_type P Boolean ∧ is_type P Integer ∧
is_type P NT ∧ is_type P (Class C) = is_class P C"
by(simp add:is_type_def)
abbreviation
"types P == Collect (is_type P)"
lemma class_exists_equiv:
"(∃x. fst x = cn ∧ x ∈ set P) = (class P cn ≠ None)"
proof(rule iffI)
assume "∃x. fst x = cn ∧ x ∈ set P" then show "class P cn ≠ None"
by (metis class_def image_eqI map_of_eq_None_iff)
next
assume "class P cn ≠ None" then show "∃x. fst x = cn ∧ x ∈ set P"
by (metis class_def fst_conv map_of_SomeD option.exhaust)
qed
lemma class_exists_equiv2:
"(∃x. fst x = cn ∧ x ∈ set (P1 @ P2)) = (class P1 cn ≠ None ∨ class P2 cn ≠ None)"
by (simp only: class_exists_equiv [where P = "P1@P2"], simp add: class_def)
end
Theory TypeRel
section ‹ Relations between Jinja Types ›
theory TypeRel imports
"HOL-Library.Transitive_Closure_Table"
Decl
begin
subsection ‹ The subclass relations ›
inductive_set
subcls1 :: "'m prog ⇒ (cname × cname) set"
and subcls1' :: "'m prog ⇒ [cname, cname] ⇒ bool" ("_ ⊢ _ ≺⇧1 _" [71,71,71] 70)
for P :: "'m prog"
where
"P ⊢ C ≺⇧1 D ≡ (C,D) ∈ subcls1 P"
| subcls1I: "⟦class P C = Some (D,rest); C ≠ Object⟧ ⟹ P ⊢ C ≺⇧1 D"
abbreviation
subcls :: "'m prog ⇒ [cname, cname] ⇒ bool" ("_ ⊢ _ ≼⇧* _" [71,71,71] 70)
where "P ⊢ C ≼⇧* D ≡ (C,D) ∈ (subcls1 P)⇧*"
lemma subcls1D: "P ⊢ C ≺⇧1 D ⟹ C ≠ Object ∧ (∃fs ms. class P C = Some (D,fs,ms))"
by(erule subcls1.induct)(fastforce simp add:is_class_def)
lemma [iff]: "¬ P ⊢ Object ≺⇧1 C"
by(fastforce dest:subcls1D)
lemma [iff]: "(P ⊢ Object ≼⇧* C) = (C = Object)"
proof(rule iffI)
assume "P ⊢ Object ≼⇧* C" then show "C = Object"
by(auto elim: converse_rtranclE)
qed simp
lemma subcls1_def2:
"subcls1 P =
(SIGMA C:{C. is_class P C}. {D. C≠Object ∧ fst (the (class P C))=D})"
by (fastforce simp:is_class_def dest: subcls1D elim: subcls1I)
lemma finite_subcls1: "finite (subcls1 P)"
proof -
let ?SIG = "SIGMA C:{C. is_class P C}. {D. fst (the (class P C)) = D ∧ C ≠ Object}"
have "subcls1 P = ?SIG" by(simp add: subcls1_def2)
also have "finite ?SIG"
proof(rule finite_SigmaI [OF finite_is_class])
fix C assume C_in: "C ∈ {C. is_class P C}"
then show "finite {D. fst (the (class P C)) = D ∧ C ≠ Object}"
by(rule_tac finite_subset[where B = "{fst (the (class P C))}"]) auto
qed
ultimately show ?thesis by simp
qed
primrec supercls_lst :: "'m prog ⇒ cname list ⇒ bool" where
"supercls_lst P (C#Cs) = ((∀C' ∈ set Cs. P ⊢ C' ≼⇧* C) ∧ supercls_lst P Cs)" |
"supercls_lst P [] = True"
lemma supercls_lst_app:
"⟦ supercls_lst P (C#Cs); P ⊢ C ≼⇧* C' ⟧ ⟹ supercls_lst P (C'#C#Cs)"
by auto
subsection‹ The subtype relations ›
inductive
widen :: "'m prog ⇒ ty ⇒ ty ⇒ bool" ("_ ⊢ _ ≤ _" [71,71,71] 70)
for P :: "'m prog"
where
widen_refl[iff]: "P ⊢ T ≤ T"
| widen_subcls: "P ⊢ C ≼⇧* D ⟹ P ⊢ Class C ≤ Class D"
| widen_null[iff]: "P ⊢ NT ≤ Class C"
abbreviation
widens :: "'m prog ⇒ ty list ⇒ ty list ⇒ bool"
("_ ⊢ _ [≤] _" [71,71,71] 70) where
"widens P Ts Ts' ≡ list_all2 (widen P) Ts Ts'"
lemma [iff]: "(P ⊢ T ≤ Void) = (T = Void)"
by (auto elim: widen.cases)
lemma [iff]: "(P ⊢ T ≤ Boolean) = (T = Boolean)"
by (auto elim: widen.cases)
lemma [iff]: "(P ⊢ T ≤ Integer) = (T = Integer)"
by (auto elim: widen.cases)
lemma [iff]: "(P ⊢ Void ≤ T) = (T = Void)"
by (auto elim: widen.cases)
lemma [iff]: "(P ⊢ Boolean ≤ T) = (T = Boolean)"
by (auto elim: widen.cases)
lemma [iff]: "(P ⊢ Integer ≤ T) = (T = Integer)"
by (auto elim: widen.cases)
lemma Class_widen: "P ⊢ Class C ≤ T ⟹ ∃D. T = Class D"
by (ind_cases "P ⊢ Class C ≤ T") auto
lemma [iff]: "(P ⊢ T ≤ NT) = (T = NT)"
by(cases T) (auto dest:Class_widen)
lemma Class_widen_Class [iff]: "(P ⊢ Class C ≤ Class D) = (P ⊢ C ≼⇧* D)"
proof(rule iffI)
show "P ⊢ Class C ≤ Class D ⟹ P ⊢ C ≼⇧* D"
proof(ind_cases "P ⊢ Class C ≤ Class D") qed(auto)
qed(auto elim: widen_subcls)
lemma widen_Class: "(P ⊢ T ≤ Class C) = (T = NT ∨ (∃D. T = Class D ∧ P ⊢ D ≼⇧* C))"
by(induct T, auto)
lemma widen_trans[trans]: "⟦P ⊢ S ≤ U; P ⊢ U ≤ T⟧ ⟹ P ⊢ S ≤ T"
proof -
assume "P⊢S ≤ U" thus "⋀T. P ⊢ U ≤ T ⟹ P ⊢ S ≤ T"
proof induct
case (widen_refl T T') thus "P ⊢ T ≤ T'" .
next
case (widen_subcls C D T)
then obtain E where "T = Class E" by (blast dest: Class_widen)
with widen_subcls show "P ⊢ Class C ≤ T" by (auto elim: rtrancl_trans)
next
case (widen_null C RT)
then obtain D where "RT = Class D" by (blast dest: Class_widen)
thus "P ⊢ NT ≤ RT" by auto
qed
qed
lemma widens_trans [trans]: "⟦P ⊢ Ss [≤] Ts; P ⊢ Ts [≤] Us⟧ ⟹ P ⊢ Ss [≤] Us"
by (rule list_all2_trans, rule widen_trans)
lemmas widens_refl [iff] = list_all2_refl [of "widen P", OF widen_refl] for P
lemmas widens_Cons [iff] = list_all2_Cons1 [of "widen P"] for P
subsection‹ Method lookup ›
inductive
Methods :: "['m prog, cname, mname ⇀ (staticb × ty list × ty × 'm) × cname] ⇒ bool"
("_ ⊢ _ sees'_methods _" [51,51,51] 50)
for P :: "'m prog"
where
sees_methods_Object:
"⟦ class P Object = Some(D,fs,ms); Mm = map_option (λm. (m,Object)) ∘ map_of ms ⟧
⟹ P ⊢ Object sees_methods Mm"
| sees_methods_rec:
"⟦ class P C = Some(D,fs,ms); C ≠ Object; P ⊢ D sees_methods Mm;
Mm' = Mm ++ (map_option (λm. (m,C)) ∘ map_of ms) ⟧
⟹ P ⊢ C sees_methods Mm'"
lemma sees_methods_fun:
assumes 1: "P ⊢ C sees_methods Mm"
shows "⋀Mm'. P ⊢ C sees_methods Mm' ⟹ Mm' = Mm"
using 1
proof induct
case (sees_methods_rec C D fs ms Dres Cres Cres')
have "class": "class P C = Some (D, fs, ms)"
and notObj: "C ≠ Object" and Dmethods: "P ⊢ D sees_methods Dres"
and IH: "⋀Dres'. P ⊢ D sees_methods Dres' ⟹ Dres' = Dres"
and Cres: "Cres = Dres ++ (map_option (λm. (m,C)) ∘ map_of ms)"
and Cmethods': "P ⊢ C sees_methods Cres'" by fact+
from Cmethods' notObj "class" obtain Dres'
where Dmethods': "P ⊢ D sees_methods Dres'"
and Cres': "Cres' = Dres' ++ (map_option (λm. (m,C)) ∘ map_of ms)"
by(auto elim: Methods.cases)
from Cres Cres' IH[OF Dmethods'] show "Cres' = Cres" by simp
next
case sees_methods_Object thus ?case by(auto elim: Methods.cases)
qed
lemma visible_methods_exist:
"P ⊢ C sees_methods Mm ⟹ Mm M = Some(m,D) ⟹
(∃D' fs ms. class P D = Some(D',fs,ms) ∧ map_of ms M = Some m)"
by(induct rule:Methods.induct) auto
lemma sees_methods_decl_above:
assumes Csees: "P ⊢ C sees_methods Mm"
shows "Mm M = Some(m,D) ⟹ P ⊢ C ≼⇧* D"
using Csees
proof induct
next
case sees_methods_Object thus ?case by auto
next
case sees_methods_rec thus ?case
by(fastforce simp:map_option_case split:option.splits
elim:converse_rtrancl_into_rtrancl[OF subcls1I])
qed
lemma sees_methods_idemp:
assumes Cmethods: "P ⊢ C sees_methods Mm"
shows "⋀m D. Mm M = Some(m,D) ⟹
∃Mm'. (P ⊢ D sees_methods Mm') ∧ Mm' M = Some(m,D)"
using Cmethods
proof induct
case sees_methods_Object thus ?case
by(fastforce dest: Methods.sees_methods_Object)
next
case sees_methods_rec thus ?case
by(fastforce split:option.splits dest: Methods.sees_methods_rec)
qed
lemma sees_methods_decl_mono:
assumes sub: "P ⊢ C' ≼⇧* C"
shows "P ⊢ C sees_methods Mm ⟹
∃Mm' Mm⇩2. P ⊢ C' sees_methods Mm' ∧ Mm' = Mm ++ Mm⇩2 ∧
(∀M m D. Mm⇩2 M = Some(m,D) ⟶ P ⊢ D ≼⇧* C)"
(is "_ ⟹ ∃Mm' Mm2. ?Q C' C Mm' Mm2")
using sub
proof (induct rule:converse_rtrancl_induct)
assume "P ⊢ C sees_methods Mm"
hence "?Q C C Mm Map.empty" by simp
thus "∃Mm' Mm2. ?Q C C Mm' Mm2" by blast
next
fix C'' C'
assume sub1: "P ⊢ C'' ≺⇧1 C'" and sub: "P ⊢ C' ≼⇧* C"
and IH: "P ⊢ C sees_methods Mm ⟹
∃Mm' Mm2. P ⊢ C' sees_methods Mm' ∧
Mm' = Mm ++ Mm2 ∧ (∀M m D. Mm2 M = Some(m,D) ⟶ P ⊢ D ≼⇧* C)"
and Csees: "P ⊢ C sees_methods Mm"
from IH[OF Csees] obtain Mm' Mm2 where C'sees: "P ⊢ C' sees_methods Mm'"
and Mm': "Mm' = Mm ++ Mm2"
and subC:"∀M m D. Mm2 M = Some(m,D) ⟶ P ⊢ D ≼⇧* C" by blast
obtain fs ms where "class": "class P C'' = Some(C',fs,ms)" "C'' ≠ Object"
using subcls1D[OF sub1] by blast
let ?Mm3 = "map_option (λm. (m,C'')) ∘ map_of ms"
have "P ⊢ C'' sees_methods (Mm ++ Mm2) ++ ?Mm3"
using sees_methods_rec[OF "class" C'sees refl] Mm' by simp
hence "?Q C'' C ((Mm ++ Mm2) ++ ?Mm3) (Mm2++?Mm3)"
using converse_rtrancl_into_rtrancl[OF sub1 sub]
by simp (simp add:map_add_def subC split:option.split)
thus "∃Mm' Mm2. ?Q C'' C Mm' Mm2" by blast
qed
lemma sees_methods_is_class_Object:
"P ⊢ D sees_methods Mm ⟹ is_class P Object"
by(induct rule: Methods.induct; simp add: is_class_def)
lemma sees_methods_sub_Obj: "P ⊢ C sees_methods Mm ⟹ P ⊢ C ≼⇧* Object"
proof(induct rule: Methods.induct)
case (sees_methods_rec C D fs ms Mm Mm') show ?case
using subcls1I[OF sees_methods_rec.hyps(1,2)] sees_methods_rec.hyps(4)
by(rule converse_rtrancl_into_rtrancl)
qed(simp)
definition Method :: "'m prog ⇒ cname ⇒ mname ⇒ staticb ⇒ ty list ⇒ ty ⇒ 'm ⇒ cname ⇒ bool"
("_ ⊢ _ sees _, _ : _→_ = _ in _" [51,51,51,51,51,51,51,51] 50)
where
"P ⊢ C sees M, b: Ts→T = m in D ≡
∃Mm. P ⊢ C sees_methods Mm ∧ Mm M = Some((b,Ts,T,m),D)"
definition has_method :: "'m prog ⇒ cname ⇒ mname ⇒ staticb ⇒ bool"
("_ ⊢ _ has _, _" [51,0,0,51] 50)
where
"P ⊢ C has M, b ≡ ∃Ts T m D. P ⊢ C sees M,b:Ts→T = m in D"
lemma sees_method_fun:
"⟦P ⊢ C sees M,b:TS→T = m in D; P ⊢ C sees M,b':TS'→T' = m' in D' ⟧
⟹ b = b' ∧ TS' = TS ∧ T' = T ∧ m' = m ∧ D' = D"
by(fastforce dest: sees_methods_fun simp:Method_def)
lemma sees_method_decl_above:
"P ⊢ C sees M,b:Ts→T = m in D ⟹ P ⊢ C ≼⇧* D"
by(clarsimp simp:Method_def sees_methods_decl_above)
lemma visible_method_exists:
"P ⊢ C sees M,b:Ts→T = m in D ⟹
∃D' fs ms. class P D = Some(D',fs,ms) ∧ map_of ms M = Some(b,Ts,T,m)"
by(fastforce simp:Method_def dest!: visible_methods_exist)
lemma sees_method_idemp:
"P ⊢ C sees M,b:Ts→T=m in D ⟹ P ⊢ D sees M,b:Ts→T=m in D"
by(fastforce simp: Method_def intro:sees_methods_idemp)
lemma sees_method_decl_mono:
assumes sub: "P ⊢ C' ≼⇧* C" and
C_sees: "P ⊢ C sees M,b:Ts→T=m in D" and
C'_sees: "P ⊢ C' sees M,b':Ts'→T'=m' in D'"
shows "P ⊢ D' ≼⇧* D"
proof -
obtain Ms where Ms: "P ⊢ C sees_methods Ms"
using C_sees by(auto simp: Method_def)
obtain Ms' Ms2 where Ms': "P ⊢ C' sees_methods Ms'" and
Ms'_def: "Ms' = Ms ++ Ms2" and
Ms2_imp: "(∀M m D. Ms2 M = ⌊(m, D)⌋ ⟶ P ⊢ D ≼⇧* C)"
using sees_methods_decl_mono[OF sub Ms] by clarsimp
have "(Ms ++ Ms2) M = ⌊((b', Ts', T', m'), D')⌋"
using C'_sees sees_methods_fun[OF Ms'] Ms'_def by(clarsimp simp: Method_def)
then have "Ms2 M = ⌊((b', Ts', T', m'), D')⌋ ∨
Ms2 M = None ∧ b = b' ∧ Ts = Ts' ∧ T = T' ∧ m = m' ∧ D = D'"
using C_sees sees_methods_fun[OF Ms] by(clarsimp simp: Method_def)
also have "Ms2 M = ⌊((b', Ts', T', m'), D')⌋ ⟹ P ⊢ D' ≼⇧* C"
using Ms2_imp by simp
ultimately show ?thesis using sub sees_method_decl_above[OF C_sees] by auto
qed
lemma sees_methods_is_class: "P ⊢ C sees_methods Mm ⟹ is_class P C"
by (auto simp add: is_class_def elim: Methods.induct)
lemma sees_method_is_class:
"⟦ P ⊢ C sees M,b:Ts→T=m in D ⟧ ⟹ is_class P C"
by (auto simp add: is_class_def Method_def dest: sees_methods_is_class)
lemma sees_method_is_class':
"⟦ P ⊢ C sees M,b:Ts→T=m in D ⟧ ⟹ is_class P D"
by(drule sees_method_idemp, rule sees_method_is_class, assumption)
lemma sees_method_sub_Obj: "P ⊢ C sees M,b: Ts→T = m in D ⟹ P ⊢ C ≼⇧* Object"
by(auto simp: Method_def sees_methods_sub_Obj)
subsection‹ Field lookup ›
inductive
Fields :: "['m prog, cname, ((vname × cname) × staticb × ty) list] ⇒ bool"
("_ ⊢ _ has'_fields _" [51,51,51] 50)
for P :: "'m prog"
where
has_fields_rec:
"⟦ class P C = Some(D,fs,ms); C ≠ Object; P ⊢ D has_fields FDTs;
FDTs' = map (λ(F,b,T). ((F,C),b,T)) fs @ FDTs ⟧
⟹ P ⊢ C has_fields FDTs'"
| has_fields_Object:
"⟦ class P Object = Some(D,fs,ms); FDTs = map (λ(F,b,T). ((F,Object),b,T)) fs ⟧
⟹ P ⊢ Object has_fields FDTs"
lemma has_fields_is_class:
"P ⊢ C has_fields FDTs ⟹ is_class P C"
by (auto simp add: is_class_def elim: Fields.induct)
lemma has_fields_fun:
assumes 1: "P ⊢ C has_fields FDTs"
shows "⋀FDTs'. P ⊢ C has_fields FDTs' ⟹ FDTs' = FDTs"
using 1
proof induct
case (has_fields_rec C D fs ms Dres Cres Cres')
have "class": "class P C = Some (D, fs, ms)"
and notObj: "C ≠ Object" and DFields: "P ⊢ D has_fields Dres"
and IH: "⋀Dres'. P ⊢ D has_fields Dres' ⟹ Dres' = Dres"
and Cres: "Cres = map (λ(F,b,T). ((F,C),b,T)) fs @ Dres"
and CFields': "P ⊢ C has_fields Cres'" by fact+
from CFields' notObj "class" obtain Dres'
where DFields': "P ⊢ D has_fields Dres'"
and Cres': "Cres' = map (λ(F,b,T). ((F,C),b,T)) fs @ Dres'"
by(auto elim: Fields.cases)
from Cres Cres' IH[OF DFields'] show "Cres' = Cres" by simp
next
case has_fields_Object thus ?case by(auto elim: Fields.cases)
qed
lemma all_fields_in_has_fields:
assumes sub: "P ⊢ C has_fields FDTs"
shows "⟦ P ⊢ C ≼⇧* D; class P D = Some(D',fs,ms); (F,b,T) ∈ set fs ⟧
⟹ ((F,D),b,T) ∈ set FDTs"
using sub proof(induct)
case (has_fields_rec C D' fs ms FDTs FDTs')
then have C_D: "P ⊢ C ≼⇧* D" by simp
then show ?case proof(rule converse_rtranclE)
assume "C = D"
then show ?case using has_fields_rec by force
next
fix y assume sub1: "P ⊢ C ≺⇧1 y" and sub2: "P ⊢ y ≼⇧* D"
then show ?case using has_fields_rec subcls1D[OF sub1] by simp
qed
next
case (has_fields_Object D fs ms FDTs)
then show ?case by force
qed
lemma has_fields_decl_above:
assumes fields: "P ⊢ C has_fields FDTs"
shows "((F,D),b,T) ∈ set FDTs ⟹ P ⊢ C ≼⇧* D"
using fields proof(induct)
case (has_fields_rec C D' fs ms FDTs FDTs')
then have "((F, D), b, T) ∈ (λx. case x of (F, x) ⇒ ((F, C), x)) ` set fs ∨
((F, D), b, T) ∈ set FDTs" by clarsimp
then show ?case proof(rule disjE)
assume "((F, D), b, T) ∈ (λx. case x of (F, x) ⇒ ((F, C), x)) ` set fs"
then show ?case using has_fields_rec by clarsimp
next
assume "((F, D), b, T) ∈ set FDTs"
then show ?case using has_fields_rec
by(blast dest:subcls1I converse_rtrancl_into_rtrancl)
qed
next
case (has_fields_Object D fs ms FDTs)
then show ?case by fastforce
qed
lemma subcls_notin_has_fields:
assumes fields: "P ⊢ C has_fields FDTs"
shows "((F,D),b,T) ∈ set FDTs ⟹ (D,C) ∉ (subcls1 P)⇧+"
using fields proof(induct)
case (has_fields_rec C D' fs ms FDTs FDTs')
then have "((F, D), b, T) ∈ (λx. case x of (F, x) ⇒ ((F, C), x)) ` set fs
∨ ((F, D), b, T) ∈ set FDTs" by clarsimp
then show ?case proof(rule disjE)
assume "((F, D), b, T) ∈ (λx. case x of (F, x) ⇒ ((F, C), x)) ` set fs"
then have CD[simp]: "C = D" and fs: "(F, b, T) ∈ set fs" by clarsimp+
then have "(D, D) ∈ (subcls1 P)⇧+ ⟹ False" proof -
assume DD: "(D, D) ∈ (subcls1 P)⇧+"
obtain z where z1: "P ⊢ D ≺⇧1 z" and z_s: "P ⊢ z ≼⇧* D"
using tranclD[OF DD] by clarsimp
have [simp]: "z = D'" using subcls1D[OF z1] has_fields_rec.hyps(1) by clarsimp
then have "((F, D), b, T) ∈ set FDTs"
using z_s all_fields_in_has_fields[OF has_fields_rec.hyps(3) _ has_fields_rec.hyps(1) fs]
by simp
then have "(D, z) ∉ (subcls1 P)⇧+" using has_fields_rec.hyps(4) by simp
then show False using z1 by auto
qed
then show ?case by clarsimp
next
assume "((F, D), b, T) ∈ set FDTs"
then show ?case using has_fields_rec by(blast dest:subcls1I trancl_into_trancl)
qed
next
case (has_fields_Object D fs ms FDTs)
then show ?case by(fastforce dest: tranclD)
qed
lemma subcls_notin_has_fields2:
assumes fields: "P ⊢ C has_fields FDTs"
shows "⟦ C ≠ Object; P ⊢ C ≺⇧1 D ⟧ ⟹ (D,C) ∉ (subcls1 P)⇧*"
using fields proof(induct arbitrary: D)
case has_fields_rec
have "∀C C' P. (C, C') ∉ subcls1 P ∨ C ≠ Object ∧ (∃fs ms. class P C = ⌊(C', fs, ms)⌋)"
using subcls1D by blast
then have "(D, D) ∉ (subcls1 P)⇧+"
by (metis (no_types) Pair_inject has_fields_rec.hyps(1) has_fields_rec.hyps(4)
has_fields_rec.prems(2) option.inject tranclD)
then show ?case
by (meson has_fields_rec.prems(2) rtrancl_into_trancl1)
qed(fastforce dest: tranclD)
lemma has_fields_mono_lem:
assumes sub: "P ⊢ D ≼⇧* C"
shows "P ⊢ C has_fields FDTs
⟹ ∃pre. P ⊢ D has_fields pre@FDTs ∧ dom(map_of pre) ∩ dom(map_of FDTs) = {}"
using sub proof(induct rule:converse_rtrancl_induct)
case base
then show ?case by(rule_tac x = "[]" in exI) simp
next
case (step D' D)
then obtain pre where D_flds: "P ⊢ D has_fields pre @ FDTs" and
dom: "dom (map_of pre) ∩ dom (map_of FDTs) = {}" by clarsimp
have "(D',C) ∈ (subcls1 P)^+" by (rule rtrancl_into_trancl2[OF step.hyps(1,2)])
obtain fs ms where D'_cls: "class P D' = ⌊(D, fs, ms)⌋" "D' ≠ Object"
using subcls1D[OF step.hyps(1)] by clarsimp+
have "P ⊢ D' has_fields map (λ(F, T). ((F, D'), T)) fs @ pre @ FDTs"
using has_fields_rec[OF D'_cls D_flds] by simp
also have "dom (map_of (map (λ(F, T). ((F, D'), T)) fs @ pre))
∩ dom (map_of FDTs) = {}"
using dom subcls_notin_has_fields[OF D_flds, where D=D'] step.hyps(1)
by(auto simp:dom_map_of_conv_image_fst) fast
ultimately show ?case
by(rule_tac x = "map (λ(F,b,T). ((F,D'),b,T)) fs @ pre" in exI) simp
qed
lemma has_fields_declaring_classes:
shows "P ⊢ C has_fields FDTs
⟹ ∃pre FDTs'. FDTs = pre@FDTs'
∧ (C ≠ Object ⟶ (∃D fs ms. class P C = ⌊(D,fs,ms)⌋ ∧ P ⊢ D has_fields FDTs'))
∧ set(map (λt. snd(fst t)) pre) ⊆ {C}
∧ set(map (λt. snd(fst t)) FDTs') ⊆ {C'. C' ≠ C ∧ P ⊢ C ≼⇧* C'}"
proof(induct rule:Fields.induct)
case (has_fields_rec C D fs ms FDTs FDTs')
have sup1: "P ⊢ C ≺⇧1 D" using has_fields_rec.hyps(1,2) by (simp add: subcls1.subcls1I)
have "P ⊢ C has_fields FDTs'"
using Fields.has_fields_rec[OF has_fields_rec.hyps(1-3)] has_fields_rec by auto
then have nsup: "(D, C) ∉ (subcls1 P)⇧*" using subcls_notin_has_fields2 sup1 by auto
show ?case using has_fields_rec sup1 nsup
by(rule_tac x = "map (λ(F, y). ((F, C), y)) fs" in exI, clarsimp) auto
next
case has_fields_Object then show ?case by fastforce
qed
lemma has_fields_mono_lem2:
assumes hf: "P ⊢ C has_fields FDTs"
and cls: "class P C = Some(D,fs,ms)" and map_of: "map_of FDTs (F,C) = ⌊(b,T)⌋"
shows "∃FDTs'. FDTs = (map (λ(F,b,T). ((F,C),b,T)) fs) @ FDTs' ∧ map_of FDTs' (F,C) = None"
using assms
proof(cases "C = Object")
case False
let ?pre = "map (λ(F,b,T). ((F,C),b,T)) fs"
have sub: "P ⊢ C ≼⇧* D" using cls False by (simp add: r_into_rtrancl subcls1.subcls1I)
obtain FDTs' where fdts': "P ⊢ D has_fields FDTs'" "FDTs = ?pre @ FDTs'"
using False assms(1,2) Fields.simps[of P C FDTs] by clarsimp
then have int: "dom (map_of ?pre) ∩ dom (map_of FDTs') = {}"
using has_fields_mono_lem[OF sub, of FDTs'] has_fields_fun[OF hf] by fastforce
have "C ∉ (λt. snd (fst t)) ` set FDTs'"
using has_fields_declaring_classes[OF hf] cls False
has_fields_fun[OF fdts'(1)] fdts'(2)
by clarify auto
then have "map_of FDTs' (F,C) = None" by(rule map_of_set_pcs_notin)
then show ?thesis using fdts' int by simp
qed(auto dest: has_fields_Object has_fields_fun)
lemma has_fields_is_class_Object:
"P ⊢ D has_fields FDTs ⟹ is_class P Object"
by(induct rule: Fields.induct; simp add: is_class_def)
lemma Object_fields:
"⟦ P ⊢ Object has_fields FDTs; C ≠ Object ⟧ ⟹ map_of FDTs (F,C) = None"
by(drule Fields.cases, auto simp: map_of_reinsert_neq_None)
definition has_field :: "'m prog ⇒ cname ⇒ vname ⇒ staticb ⇒ ty ⇒ cname ⇒ bool"
("_ ⊢ _ has _,_:_ in _" [51,51,51,51,51,51] 50)
where
"P ⊢ C has F,b:T in D ≡
∃FDTs. P ⊢ C has_fields FDTs ∧ map_of FDTs (F,D) = Some (b,T)"
lemma has_field_mono:
assumes has: " P ⊢ C has F,b:T in D" and sub: "P ⊢ C' ≼⇧* C"
shows "P ⊢ C' has F,b:T in D"
proof -
obtain FDTs where FDTs:"P ⊢ C has_fields FDTs" and "map_of FDTs (F, D) = ⌊(b, T)⌋"
using has by(clarsimp simp: has_field_def)
also obtain pre where "P ⊢ C' has_fields pre @ FDTs"
and "dom (map_of pre) ∩ dom (map_of FDTs) = {}"
using has_fields_mono_lem[OF sub FDTs] by clarify
ultimately show ?thesis by(fastforce simp: has_field_def map_add_def split:option.splits)
qed
lemma has_field_fun:
"⟦P ⊢ C has F,b:T in D; P ⊢ C has F,b':T' in D⟧ ⟹ b = b' ∧ T' = T"
by(fastforce simp:has_field_def dest:has_fields_fun)
lemma has_field_idemp:
assumes has: "P ⊢ C has F,b:T in D"
shows "P ⊢ D has F,b:T in D"
proof -
obtain FDTs where C_flds: "P ⊢ C has_fields FDTs"
and FDTs: "map_of FDTs (F, D) = ⌊(b, T)⌋" (is "?FDTs")
using has by(clarsimp simp: has_field_def)
have map: "⋀C' fs. map_of (map (λ(F, y). ((F, C'), y)) fs) (F, D) = ⌊(b, T)⌋ ⟹ D = C'"
by(frule map_of_SomeD) clarsimp
have "?FDTs ⟶ P ⊢ D has F,b:T in D"
using C_flds proof induct
case NObj: (has_fields_rec C' D' fs ms FDTs FDTs')
then show ?case using map by (fastforce intro: has_fields_rec simp: has_field_def)
next
case Obj: (has_fields_Object D fs ms FDTs)
then show ?case using map by(fastforce intro: has_fields_Object simp: has_field_def)
qed
then show ?thesis using FDTs by(rule_tac mp)
qed
lemma visible_fields_exist:
assumes fields: "P ⊢ C has_fields FDTs" and
FDTs: "map_of FDTs (F,D) = Some (b, T)"
shows "∃D' fs ms. class P D = Some(D',fs,ms) ∧ map_of fs F = Some(b,T)"
proof -
have "map_of FDTs (F,D) = Some (b, T) ⟶
(∃D' fs ms. class P D = Some(D',fs,ms) ∧ map_of fs F = Some(b,T))"
using fields proof induct
case (has_fields_rec C' D' fs ms FDTs')
with assms map_of_reinsert_SomeD map_of_reinsert_neq_None[where D=D and F=F and fs=fs]
show ?case proof(cases "C' = D") qed auto
next
case (has_fields_Object D' fs ms FDTs)
with assms map_of_reinsert_SomeD map_of_reinsert_neq_None[where D=D and F=F and fs=fs]
show ?case proof(cases "Object = D") qed auto
qed
then show ?thesis using FDTs by simp
qed
lemma map_of_remap_SomeD:
"map_of (map (λ((k,k'),x). (k,(k',x))) t) k = Some (k',x) ⟹ map_of t (k, k') = Some x"
by (induct t) (auto simp:fun_upd_apply split: if_split_asm)
lemma map_of_remap_SomeD2:
"map_of (map (λ((k,k'),x,x'). (k,(k',x,x'))) t) k = Some (k',x,x') ⟹ map_of t (k, k') = Some (x, x')"
by (induct t) (auto simp:fun_upd_apply split: if_split_asm)
lemma has_field_decl_above:
"P ⊢ C has F,b:T in D ⟹ P ⊢ C ≼⇧* D"
by(auto simp: has_field_def
intro: has_fields_decl_above map_of_SomeD map_of_remap_SomeD2)
definition sees_field :: "'m prog ⇒ cname ⇒ vname ⇒ staticb ⇒ ty ⇒ cname ⇒ bool"
("_ ⊢ _ sees _,_:_ in _" [51,51,51,51,51,51] 50)
where
"P ⊢ C sees F,b:T in D ≡
∃FDTs. P ⊢ C has_fields FDTs ∧
map_of (map (λ((F,D),b,T). (F,(D,b,T))) FDTs) F = Some(D,b,T)"
lemma has_visible_field:
"P ⊢ C sees F,b:T in D ⟹ P ⊢ C has F,b:T in D"
by(auto simp add:has_field_def sees_field_def map_of_remap_SomeD2)
lemma sees_field_fun:
"⟦P ⊢ C sees F,b:T in D; P ⊢ C sees F,b':T' in D'⟧ ⟹ b = b' ∧ T' = T ∧ D' = D"
by(fastforce simp:sees_field_def dest:has_fields_fun)
lemma sees_field_decl_above:
"P ⊢ C sees F,b:T in D ⟹ P ⊢ C ≼⇧* D"
by(auto simp:sees_field_def
intro: has_fields_decl_above map_of_SomeD map_of_remap_SomeD2)
lemma sees_field_idemp:
assumes sees: "P ⊢ C sees F,b:T in D"
shows "P ⊢ D sees F,b:T in D"
proof -
obtain FDTs where C_flds: "P ⊢ C has_fields FDTs"
and FDTs: "map_of (map (λ((F, D), b, T). (F, D, b, T)) FDTs) F = ⌊(D, b, T)⌋"
(is "?FDTs")
using sees by(clarsimp simp: sees_field_def)
have map: "⋀C' fs. map_of (map ((λ((F, D), a). (F, D, a)) ∘ (λ(F, y). ((F, C'), y))) fs) F
= ⌊(D, b, T)⌋
⟹ D = C' ∧ (F, b, T) ∈ set fs"
by(frule map_of_SomeD) clarsimp
have "?FDTs ⟶ (∃FDTs. P ⊢ D has_fields FDTs
∧ map_of (map (λ((F, D), a). (F, D, a)) FDTs) F = ⌊(D, b, T)⌋)"
using C_flds proof induct
case NObj: (has_fields_rec C' D' fs ms FDTs FDTs')
then show ?case using map by (fastforce intro: has_fields_rec)
next
case Obj: (has_fields_Object D fs ms FDTs)
then show ?case using map by(fastforce intro: has_fields_Object)
qed
then show ?thesis using FDTs
by (smt map_eq_conv old.prod.case prod_cases3 sees_field_def split_cong)
qed
lemma has_field_sees_aux:
assumes hf: "P ⊢ C has_fields FDTs" and map: "map_of FDTs (F, C) = ⌊(b, T)⌋"
shows "map_of (map (λ((F, D), b, T). (F, D, b, T)) FDTs) F = ⌊(C, b, T)⌋"
proof -
obtain D fs ms where fs: "class P C = Some(D,fs,ms)"
using visible_fields_exist[OF assms] by clarsimp
then obtain FDTs' where
"FDTs = map (λ(F, b, T). ((F, C), b, T)) fs @ FDTs' ∧ map_of FDTs' (F, C) = None"
using has_fields_mono_lem2[OF hf fs map] by clarsimp
then show ?thesis using map_of_Some_None_split[OF _ _ map] by auto
qed
lemma has_field_sees: "P ⊢ C has F,b:T in C ⟹ P ⊢ C sees F,b:T in C"
by(auto simp:has_field_def sees_field_def has_field_sees_aux)
lemma has_field_is_class:
"P ⊢ C has F,b:T in D ⟹ is_class P C"
by (auto simp add: is_class_def has_field_def elim: Fields.induct)
lemma has_field_is_class':
"P ⊢ C has F,b:T in D ⟹ is_class P D"
by(drule has_field_idemp, rule has_field_is_class, assumption)
subsection "Functional lookup"
definition "method" :: "'m prog ⇒ cname ⇒ mname ⇒ cname × staticb × ty list × ty × 'm"
where
"method P C M ≡ THE (D,b,Ts,T,m). P ⊢ C sees M,b:Ts → T = m in D"
definition field :: "'m prog ⇒ cname ⇒ vname ⇒ cname × staticb × ty"
where
"field P C F ≡ THE (D,b,T). P ⊢ C sees F,b:T in D"
definition fields :: "'m prog ⇒ cname ⇒ ((vname × cname) × staticb × ty) list"
where
"fields P C ≡ THE FDTs. P ⊢ C has_fields FDTs"
lemma fields_def2 [simp]: "P ⊢ C has_fields FDTs ⟹ fields P C = FDTs"
by (unfold fields_def) (auto dest: has_fields_fun)
lemma field_def2 [simp]: "P ⊢ C sees F,b:T in D ⟹ field P C F = (D,b,T)"
by (unfold field_def) (auto dest: sees_field_fun)
lemma method_def2 [simp]: "P ⊢ C sees M,b: Ts→T = m in D ⟹ method P C M = (D,b,Ts,T,m)"
by (unfold method_def) (auto dest: sees_method_fun)
text ‹ The following are the fields for initializing an object (non-static fields)
and a class (just that class's static fields), respectively. ›
definition ifields :: "'m prog ⇒ cname ⇒ ((vname × cname) × staticb × ty) list"
where
"ifields P C ≡ filter (λ((F,D),b,T). b = NonStatic) (fields P C)"
definition isfields :: "'m prog ⇒ cname ⇒ ((vname × cname) × staticb × ty) list"
where
"isfields P C ≡ filter (λ((F,D),b,T). b = Static ∧ D = C) (fields P C)"
lemma ifields_def2[simp]: "⟦ P ⊢ C has_fields FDTs ⟧ ⟹ ifields P C = filter (λ((F,D),b,T). b = NonStatic) FDTs"
by (simp add: ifields_def)
lemma isfields_def2[simp]: "⟦ P ⊢ C has_fields FDTs ⟧ ⟹ isfields P C = filter (λ((F,D),b,T). b = Static ∧ D = C) FDTs"
by (simp add: isfields_def)
lemma ifields_def3: "⟦ P ⊢ C sees F,b:T in D; b = NonStatic ⟧ ⟹ (((F,D),b,T) ∈ set (ifields P C))"
by (unfold ifields_def) (auto simp: sees_field_def map_of_SomeD map_of_remap_SomeD2)
lemma isfields_def3: "⟦ P ⊢ C sees F,b:T in D; b = Static; D = C ⟧ ⟹ (((F,D),b,T) ∈ set (isfields P C))"
by (unfold isfields_def) (auto simp: sees_field_def map_of_SomeD map_of_remap_SomeD2)
definition seeing_class :: "'m prog ⇒ cname ⇒ mname ⇒ cname option" where
"seeing_class P C M =
(if ∃Ts T m D. P ⊢ C sees M,Static:Ts→T = m in D
then Some (fst(method P C M))
else None)"
lemma seeing_class_def2[simp]:
"P ⊢ C sees M,Static:Ts→T = m in D ⟹ seeing_class P C M = Some D"
by(fastforce simp: seeing_class_def)
end
Theory Value
section ‹ Jinja Values ›
theory Value imports TypeRel begin
type_synonym addr = nat
datatype val
= Unit
| Null
| Bool bool
| Intg int
| Addr addr
primrec the_Intg :: "val ⇒ int" where
"the_Intg (Intg i) = i"
primrec the_Addr :: "val ⇒ addr" where
"the_Addr (Addr a) = a"
primrec default_val :: "ty ⇒ val" where
"default_val Void = Unit"
| "default_val Boolean = Bool False"
| "default_val Integer = Intg 0"
| "default_val NT = Null"
| "default_val (Class C) = Null"
end
Theory Objects
section ‹ Objects and the Heap ›
theory Objects imports TypeRel Value begin
subsection‹ Objects ›
type_synonym
fields = "vname × cname ⇀ val"
type_synonym
obj = "cname × fields"
type_synonym
sfields = "vname ⇀ val"
definition obj_ty :: "obj ⇒ ty"
where
"obj_ty obj ≡ Class (fst obj)"
definition init_fields :: "((vname × cname) × staticb × ty) list ⇒ fields"
where
"init_fields FDTs ≡ (map_of ∘ map (λ((F,D),b,T). ((F,D),default_val T))) FDTs"
definition init_sfields :: "((vname × cname) × staticb × ty) list ⇒ sfields"
where
"init_sfields FDTs ≡ (map_of ∘ map (λ((F,D),b,T). (F,default_val T))) FDTs"
definition blank :: "'m prog ⇒ cname ⇒ obj"
where
"blank P C ≡ (C,init_fields (ifields P C))"
definition sblank :: "'m prog ⇒ cname ⇒ sfields"
where
"sblank P C ≡ init_sfields (isfields P C)"
lemma [simp]: "obj_ty (C,fs) = Class C"
by (simp add: obj_ty_def)
translations
(type) "fields" <= (type) "char list × char list ⇒ val option"
(type) "obj" <= (type) "char list × fields"
(type) "sfields" <= (type) "char list ⇒ val option"
subsection‹ Heap ›
type_synonym heap = "addr ⇀ obj"
translations
(type) "heap" <= (type) "nat ⇒ obj option"
abbreviation
cname_of :: "heap ⇒ addr ⇒ cname" where
"cname_of hp a == fst (the (hp a))"
definition new_Addr :: "heap ⇒ addr option"
where
"new_Addr h ≡ if ∃a. h a = None then Some(LEAST a. h a = None) else None"
definition cast_ok :: "'m prog ⇒ cname ⇒ heap ⇒ val ⇒ bool"
where
"cast_ok P C h v ≡ v = Null ∨ P ⊢ cname_of h (the_Addr v) ≼⇧* C"
definition hext :: "heap ⇒ heap ⇒ bool" ("_ ⊴ _" [51,51] 50)
where
"h ⊴ h' ≡ ∀a C fs. h a = Some(C,fs) ⟶ (∃fs'. h' a = Some(C,fs'))"
primrec typeof_h :: "heap ⇒ val ⇒ ty option" ("typeof⇘_⇙")
where
"typeof⇘h⇙ Unit = Some Void"
| "typeof⇘h⇙ Null = Some NT"
| "typeof⇘h⇙ (Bool b) = Some Boolean"
| "typeof⇘h⇙ (Intg i) = Some Integer"
| "typeof⇘h⇙ (Addr a) = (case h a of None ⇒ None | Some(C,fs) ⇒ Some(Class C))"
lemma new_Addr_SomeD:
"new_Addr h = Some a ⟹ h a = None"
by(fastforce simp: new_Addr_def split:if_splits intro:LeastI)
lemma [simp]: "(typeof⇘h⇙ v = Some Boolean) = (∃b. v = Bool b)"
by(induct v) auto
lemma [simp]: "(typeof⇘h⇙ v = Some Integer) = (∃i. v = Intg i)"
by(cases v) auto
lemma [simp]: "(typeof⇘h⇙ v = Some NT) = (v = Null)"
by(cases v) auto
lemma [simp]: "(typeof⇘h⇙ v = Some(Class C)) = (∃a fs. v = Addr a ∧ h a = Some(C,fs))"
by(cases v) auto
lemma [simp]: "h a = Some(C,fs) ⟹ typeof⇘(h(a↦(C,fs')))⇙ v = typeof⇘h⇙ v"
by(induct v) (auto simp:fun_upd_apply)
text‹ For literal values the first parameter of @{term typeof} can be
set to @{term empty} because they do not contain addresses: ›
abbreviation
typeof :: "val ⇒ ty option" where
"typeof v == typeof_h Map.empty v"
lemma typeof_lit_typeof:
"typeof v = Some T ⟹ typeof⇘h⇙ v = Some T"
by(cases v) auto
lemma typeof_lit_is_type:
"typeof v = Some T ⟹ is_type P T"
by (induct v) (auto simp:is_type_def)
subsection ‹ Heap extension @{text"⊴"} ›
lemma hextI: "∀a C fs. h a = Some(C,fs) ⟶ (∃fs'. h' a = Some(C,fs')) ⟹ h ⊴ h'"
by(auto simp: hext_def)
lemma hext_objD: "⟦ h ⊴ h'; h a = Some(C,fs) ⟧ ⟹ ∃fs'. h' a = Some(C,fs')"
by(auto simp: hext_def)
lemma hext_refl [iff]: "h ⊴ h"
by (rule hextI) fast
lemma hext_new [simp]: "h a = None ⟹ h ⊴ h(a↦x)"
by (rule hextI) (auto simp:fun_upd_apply)
lemma hext_trans: "⟦ h ⊴ h'; h' ⊴ h'' ⟧ ⟹ h ⊴ h''"
by (rule hextI) (fast dest: hext_objD)
lemma hext_upd_obj: "h a = Some (C,fs) ⟹ h ⊴ h(a↦(C,fs'))"
by (rule hextI) (auto simp:fun_upd_apply)
lemma hext_typeof_mono: "⟦ h ⊴ h'; typeof⇘h⇙ v = Some T ⟧ ⟹ typeof⇘h'⇙ v = Some T"
proof(cases v)
case Addr assume "h ⊴ h'" and "typeof⇘h⇙ v = ⌊T⌋"
then show ?thesis using Addr by(fastforce simp:hext_def)
qed simp_all
subsection‹ Static field information function ›
datatype init_state = Done | Processing | Prepared | Error
inductive iprog :: "init_state ⇒ init_state ⇒ bool" ("_ ≤⇩i _" [51,51] 50)
where
[simp]: "Prepared ≤⇩i i"
| [simp]: "Processing ≤⇩i Done"
| [simp]: "Processing ≤⇩i Error"
| [simp]: "i ≤⇩i i"
lemma iprog_Done[simp]: "(Done ≤⇩i i) = (i = Done)"
by(simp only: iprog.simps, simp)
lemma iprog_Error[simp]: "(Error ≤⇩i i) = (i = Error)"
by(simp only: iprog.simps, simp)
lemma iprog_Processing[simp]: "(Processing ≤⇩i i) = (i = Done ∨ i = Error ∨ i = Processing)"
by(simp only: iprog.simps, simp)
lemma iprog_trans: "⟦ i ≤⇩i i'; i' ≤⇩i i'' ⟧ ⟹ i ≤⇩i i''"
by(case_tac i; case_tac i') simp_all
subsection‹ Static Heap ›
text ‹The static heap (sheap) is used for storing information about static
field values and initialization status for classes.›
type_synonym
sheap = "cname ⇀ sfields × init_state"
translations
(type) "sheap" <= (type) "char list ⇒ (sfields × init_state) option"
definition shext :: "sheap ⇒ sheap ⇒ bool" ("_ ⊴⇩s _" [51,51] 50)
where
"sh ⊴⇩s sh' ≡ ∀C sfs i. sh C = Some(sfs,i) ⟶ (∃sfs' i'. sh' C = Some(sfs',i') ∧ i ≤⇩i i')"
lemma shextI: "∀C sfs i. sh C = Some(sfs,i) ⟶ (∃sfs' i'. sh' C = Some(sfs',i') ∧ i ≤⇩i i') ⟹ sh ⊴⇩s sh'"
by(auto simp: shext_def)
lemma shext_objD: "⟦ sh ⊴⇩s sh'; sh C = Some(sfs,i) ⟧ ⟹ ∃sfs' i'. sh' C = Some(sfs', i') ∧ i ≤⇩i i'"
by(auto simp: shext_def)
lemma shext_refl [iff]: "sh ⊴⇩s sh"
by (rule shextI) auto
lemma shext_new [simp]: "sh C = None ⟹ sh ⊴⇩s sh(C↦x)"
by (rule shextI) (auto simp:fun_upd_apply)
lemma shext_trans: "⟦ sh ⊴⇩s sh'; sh' ⊴⇩s sh'' ⟧ ⟹ sh ⊴⇩s sh''"
by (rule shextI) (fast dest: iprog_trans shext_objD)
lemma shext_upd_obj: "⟦ sh C = Some (sfs,i); i ≤⇩i i' ⟧ ⟹ sh ⊴⇩s sh(C↦(sfs',i'))"
by (rule shextI) (auto simp:fun_upd_apply)
end
Theory Exceptions
section ‹ Exceptions ›
theory Exceptions imports Objects begin
definition ErrorCl :: "string" where "ErrorCl = ''Error''"
definition ThrowCl :: "string" where "ThrowCl = ''Throwable''"
definition NullPointer :: cname
where
"NullPointer ≡ ''NullPointer''"
definition ClassCast :: cname
where
"ClassCast ≡ ''ClassCast''"
definition OutOfMemory :: cname
where
"OutOfMemory ≡ ''OutOfMemory''"
definition NoClassDefFoundError :: cname
where
"NoClassDefFoundError ≡ ''NoClassDefFoundError''"
definition IncompatibleClassChangeError :: cname
where
"IncompatibleClassChangeError ≡ ''IncompatibleClassChangeError''"
definition NoSuchFieldError :: cname
where
"NoSuchFieldError ≡ ''NoSuchFieldError''"
definition NoSuchMethodError :: cname
where
"NoSuchMethodError ≡ ''NoSuchMethodError''"
definition sys_xcpts :: "cname set"
where
"sys_xcpts ≡ {NullPointer, ClassCast, OutOfMemory, NoClassDefFoundError,
IncompatibleClassChangeError,
NoSuchFieldError, NoSuchMethodError}"
definition addr_of_sys_xcpt :: "cname ⇒ addr"
where
"addr_of_sys_xcpt s ≡ if s = NullPointer then 0 else
if s = ClassCast then 1 else
if s = OutOfMemory then 2 else
if s = NoClassDefFoundError then 3 else
if s = IncompatibleClassChangeError then 4 else
if s = NoSuchFieldError then 5 else
if s = NoSuchMethodError then 6 else undefined"
lemmas sys_xcpts_defs = NullPointer_def ClassCast_def OutOfMemory_def NoClassDefFoundError_def
IncompatibleClassChangeError_def NoSuchFieldError_def NoSuchMethodError_def
lemma Start_nsys_xcpts: "Start ∉ sys_xcpts"
by(simp add: Start_def sys_xcpts_def sys_xcpts_defs)
lemma Start_nsys_xcpts1 [simp]: "Start ≠ NullPointer" "Start ≠ ClassCast"
"Start ≠ OutOfMemory" "Start ≠ NoClassDefFoundError"
"Start ≠ IncompatibleClassChangeError" "Start ≠ NoSuchFieldError"
"Start ≠ NoSuchMethodError"
using Start_nsys_xcpts by(auto simp: sys_xcpts_def)
lemma Start_nsys_xcpts2 [simp]: "NullPointer ≠ Start" "ClassCast ≠ Start"
"OutOfMemory ≠ Start" "NoClassDefFoundError ≠ Start"
"IncompatibleClassChangeError ≠ Start" "NoSuchFieldError ≠ Start"
"NoSuchMethodError ≠ Start"
using Start_nsys_xcpts by(auto simp: sys_xcpts_def dest: sym)
definition start_heap :: "'c prog ⇒ heap"
where
"start_heap G ≡ Map.empty (addr_of_sys_xcpt NullPointer ↦ blank G NullPointer)
(addr_of_sys_xcpt ClassCast ↦ blank G ClassCast)
(addr_of_sys_xcpt OutOfMemory ↦ blank G OutOfMemory)
(addr_of_sys_xcpt NoClassDefFoundError ↦ blank G NoClassDefFoundError)
(addr_of_sys_xcpt IncompatibleClassChangeError ↦ blank G IncompatibleClassChangeError)
(addr_of_sys_xcpt NoSuchFieldError ↦ blank G NoSuchFieldError)
(addr_of_sys_xcpt NoSuchMethodError ↦ blank G NoSuchMethodError)"
definition preallocated :: "heap ⇒ bool"
where
"preallocated h ≡ ∀C ∈ sys_xcpts. ∃fs. h(addr_of_sys_xcpt C) = Some (C,fs)"
subsection "System exceptions"
lemma sys_xcpts_incl [simp]: "NullPointer ∈ sys_xcpts ∧ OutOfMemory ∈ sys_xcpts
∧ ClassCast ∈ sys_xcpts ∧ NoClassDefFoundError ∈ sys_xcpts
∧ IncompatibleClassChangeError ∈ sys_xcpts ∧ NoSuchFieldError ∈ sys_xcpts
∧ NoSuchMethodError ∈ sys_xcpts"
by(simp add: sys_xcpts_def)
lemma sys_xcpts_cases [consumes 1, cases set]:
"⟦ C ∈ sys_xcpts; P NullPointer; P OutOfMemory; P ClassCast; P NoClassDefFoundError;
P IncompatibleClassChangeError; P NoSuchFieldError;
P NoSuchMethodError ⟧ ⟹ P C"
by (auto simp: sys_xcpts_def)
subsection "Starting heap"
lemma start_heap_sys_xcpts:
assumes "C ∈ sys_xcpts"
shows "start_heap P (addr_of_sys_xcpt C) = Some(blank P C)"
by(rule sys_xcpts_cases[OF assms])
(auto simp add: start_heap_def sys_xcpts_def addr_of_sys_xcpt_def sys_xcpts_defs)
lemma start_heap_classes:
"start_heap P a = Some(C,fs) ⟹ C ∈ sys_xcpts"
by(simp add: start_heap_def blank_def split: if_split_asm)
lemma start_heap_nStart: "start_heap P a = Some obj ⟹ fst(obj) ≠ Start"
by(cases obj, auto dest!: start_heap_classes simp: Start_nsys_xcpts)
subsection "@{term preallocated}"
lemma preallocated_dom [simp]:
"⟦ preallocated h; C ∈ sys_xcpts ⟧ ⟹ addr_of_sys_xcpt C ∈ dom h"
by (fastforce simp:preallocated_def dom_def)
lemma preallocatedD:
"⟦ preallocated h; C ∈ sys_xcpts ⟧ ⟹ ∃fs. h(addr_of_sys_xcpt C) = Some (C, fs)"
by(auto simp: preallocated_def sys_xcpts_def)
lemma preallocatedE [elim?]:
"⟦ preallocated h; C ∈ sys_xcpts; ⋀fs. h(addr_of_sys_xcpt C) = Some(C,fs) ⟹ P h C⟧
⟹ P h C"
by (fast dest: preallocatedD)
lemma cname_of_xcp [simp]:
"⟦ preallocated h; C ∈ sys_xcpts ⟧ ⟹ cname_of h (addr_of_sys_xcpt C) = C"
by (auto elim: preallocatedE)
lemma typeof_ClassCast [simp]:
"preallocated h ⟹ typeof⇘h⇙ (Addr(addr_of_sys_xcpt ClassCast)) = Some(Class ClassCast)"
by (auto elim: preallocatedE)
lemma typeof_OutOfMemory [simp]:
"preallocated h ⟹ typeof⇘h⇙ (Addr(addr_of_sys_xcpt OutOfMemory)) = Some(Class OutOfMemory)"
by (auto elim: preallocatedE)
lemma typeof_NullPointer [simp]:
"preallocated h ⟹ typeof⇘h⇙ (Addr(addr_of_sys_xcpt NullPointer)) = Some(Class NullPointer)"
by (auto elim: preallocatedE)
lemma typeof_NoClassDefFoundError [simp]:
"preallocated h ⟹ typeof⇘h⇙ (Addr(addr_of_sys_xcpt NoClassDefFoundError)) = Some(Class NoClassDefFoundError)"
by (auto elim: preallocatedE)
lemma typeof_IncompatibleClassChangeError [simp]:
"preallocated h ⟹ typeof⇘h⇙ (Addr(addr_of_sys_xcpt IncompatibleClassChangeError)) = Some(Class IncompatibleClassChangeError)"
by (auto elim: preallocatedE)
lemma typeof_NoSuchFieldError [simp]:
"preallocated h ⟹ typeof⇘h⇙ (Addr(addr_of_sys_xcpt NoSuchFieldError)) = Some(Class NoSuchFieldError)"
by (auto elim: preallocatedE)
lemma typeof_NoSuchMethodError [simp]:
"preallocated h ⟹ typeof⇘h⇙ (Addr(addr_of_sys_xcpt NoSuchMethodError)) = Some(Class NoSuchMethodError)"
by (auto elim: preallocatedE)
lemma preallocated_hext:
"⟦ preallocated h; h ⊴ h' ⟧ ⟹ preallocated h'"
by (simp add: preallocated_def hext_def)
lemmas preallocated_upd_obj = preallocated_hext [OF _ hext_upd_obj]
lemmas preallocated_new = preallocated_hext [OF _ hext_new]
lemma preallocated_start:
"preallocated (start_heap P)"
by(auto simp: start_heap_sys_xcpts blank_def preallocated_def)
end
Theory Expr
section ‹ Expressions ›
theory Expr
imports "../Common/Exceptions"
begin
datatype bop = Eq | Add
datatype 'a exp
= new cname
| Cast cname "('a exp)"
| Val val
| BinOp "('a exp)" bop "('a exp)" ("_ «_» _" [80,0,81] 80)
| Var 'a
| LAss 'a "('a exp)" ("_:=_" [90,90]90)
| FAcc "('a exp)" vname cname ("_∙_{_}" [10,90,99]90)
| SFAcc cname vname cname ("_∙⇩s_{_}" [10,90,99]90)
| FAss "('a exp)" vname cname "('a exp)" ("_∙_{_} := _" [10,90,99,90]90)
| SFAss cname vname cname "('a exp)" ("_∙⇩s_{_} := _" [10,90,99,90]90)
| Call "('a exp)" mname "('a exp list)" ("_∙_'(_')" [90,99,0] 90)
| SCall cname mname "('a exp list)" ("_∙⇩s_'(_')" [90,99,0] 90)
| Block 'a ty "('a exp)" ("'{_:_; _}")
| Seq "('a exp)" "('a exp)" ("_;;/ _" [61,60]60)
| Cond "('a exp)" "('a exp)" "('a exp)" ("if '(_') _/ else _" [80,79,79]70)
| While "('a exp)" "('a exp)" ("while '(_') _" [80,79]70)
| throw "('a exp)"
| TryCatch "('a exp)" cname 'a "('a exp)" ("try _/ catch'(_ _') _" [0,99,80,79] 70)
| INIT cname "cname list" bool "('a exp)" ("INIT _ '(_,_') ← _" [60,60,60,60] 60)
| RI cname "('a exp)" "cname list" "('a exp)" ("RI '(_,_') ; _ ← _" [60,60,60,60] 60)
type_synonym
expr = "vname exp"
type_synonym
J_mb = "vname list × expr"
type_synonym
J_prog = "J_mb prog"
type_synonym
init_stack = "expr list × bool"
text‹The semantics of binary operators: ›
fun binop :: "bop × val × val ⇒ val option" where
"binop(Eq,v⇩1,v⇩2) = Some(Bool (v⇩1 = v⇩2))"
| "binop(Add,Intg i⇩1,Intg i⇩2) = Some(Intg(i⇩1+i⇩2))"
| "binop(bop,v⇩1,v⇩2) = None"
lemma [simp]:
"(binop(Add,v⇩1,v⇩2) = Some v) = (∃i⇩1 i⇩2. v⇩1 = Intg i⇩1 ∧ v⇩2 = Intg i⇩2 ∧ v = Intg(i⇩1+i⇩2))"
apply(cases v⇩1)
apply auto
apply(cases v⇩2)
apply auto
done
lemma map_Val_throw_eq:
"map Val vs @ throw ex # es = map Val vs' @ throw ex' # es' ⟹ ex = ex'"
apply(induct vs arbitrary: vs')
apply(case_tac vs', auto)+
done
lemma map_Val_nthrow_neq:
"map Val vs = map Val vs' @ throw ex' # es' ⟹ False"
apply(induct vs arbitrary: vs')
apply(case_tac vs', auto)+
done
lemma map_Val_eq:
"map Val vs = map Val vs' ⟹ vs = vs'"
apply(induct vs arbitrary: vs')
apply(case_tac vs', auto)+
done
lemma init_rhs_neq [simp]: "e ≠ INIT C (Cs,b) ← e"
proof -
have "size e ≠ size (INIT C (Cs,b) ← e)" by auto
then show ?thesis by fastforce
qed
lemma init_rhs_neq' [simp]: "INIT C (Cs,b) ← e ≠ e"
proof -
have "size e ≠ size (INIT C (Cs,b) ← e)" by auto
then show ?thesis by fastforce
qed
lemma ri_rhs_neq [simp]: "e ≠ RI(C,e');Cs ← e"
proof -
have "size e ≠ size (RI(C,e');Cs ← e)" by auto
then show ?thesis by fastforce
qed
lemma ri_rhs_neq' [simp]: "RI(C,e');Cs ← e ≠ e"
proof -
have "size e ≠ size (RI(C,e');Cs ← e)" by auto
then show ?thesis by fastforce
qed
subsection "Syntactic sugar"
abbreviation (input)
InitBlock:: "'a ⇒ ty ⇒ 'a exp ⇒ 'a exp ⇒ 'a exp" ("(1'{_:_ := _;/ _})") where
"InitBlock V T e1 e2 == {V:T; V := e1;; e2}"
abbreviation unit where "unit == Val Unit"
abbreviation null where "null == Val Null"
abbreviation "addr a == Val(Addr a)"
abbreviation "true == Val(Bool True)"
abbreviation "false == Val(Bool False)"
abbreviation
Throw :: "addr ⇒ 'a exp" where
"Throw a == throw(Val(Addr a))"
abbreviation
THROW :: "cname ⇒ 'a exp" where
"THROW xc == Throw(addr_of_sys_xcpt xc)"
subsection‹Free Variables›
primrec fv :: "expr ⇒ vname set" and fvs :: "expr list ⇒ vname set" where
"fv(new C) = {}"
| "fv(Cast C e) = fv e"
| "fv(Val v) = {}"
| "fv(e⇩1 «bop» e⇩2) = fv e⇩1 ∪ fv e⇩2"
| "fv(Var V) = {V}"
| "fv(LAss V e) = {V} ∪ fv e"
| "fv(e∙F{D}) = fv e"
| "fv(C∙⇩sF{D}) = {}"
| "fv(e⇩1∙F{D}:=e⇩2) = fv e⇩1 ∪ fv e⇩2"
| "fv(C∙⇩sF{D}:=e⇩2) = fv e⇩2"
| "fv(e∙M(es)) = fv e ∪ fvs es"
| "fv(C∙⇩sM(es)) = fvs es"
| "fv({V:T; e}) = fv e - {V}"
| "fv(e⇩1;;e⇩2) = fv e⇩1 ∪ fv e⇩2"
| "fv(if (b) e⇩1 else e⇩2) = fv b ∪ fv e⇩1 ∪ fv e⇩2"
| "fv(while (b) e) = fv b ∪ fv e"
| "fv(throw e) = fv e"
| "fv(try e⇩1 catch(C V) e⇩2) = fv e⇩1 ∪ (fv e⇩2 - {V})"
| "fv(INIT C (Cs,b) ← e) = fv e"
| "fv(RI (C,e);Cs ← e') = fv e ∪ fv e'"
| "fvs([]) = {}"
| "fvs(e#es) = fv e ∪ fvs es"
lemma [simp]: "fvs(es⇩1 @ es⇩2) = fvs es⇩1 ∪ fvs es⇩2"
by (induct es⇩1 type:list) auto
lemma [simp]: "fvs(map Val vs) = {}"
by (induct vs) auto
subsection‹Accessing expression constructor arguments›
fun val_of :: "'a exp ⇒ val option" where
"val_of (Val v) = Some v" |
"val_of _ = None"
lemma val_of_spec: "val_of e = Some v ⟹ e = Val v"
proof(cases e) qed(auto)
fun lass_val_of :: "'a exp ⇒ ('a × val) option" where
"lass_val_of (V:=Val v) = Some (V, v)" |
"lass_val_of _ = None"
lemma lass_val_of_spec:
assumes "lass_val_of e = ⌊a⌋"
shows "e = (fst a:=Val (snd a))"
using assms proof(cases e)
case (LAss V e') then show ?thesis using assms proof(cases e')qed(auto)
qed(auto)
fun map_vals_of :: "'a exp list ⇒ val list option" where
"map_vals_of (e#es) = (case val_of e of Some v ⇒ (case map_vals_of es of Some vs ⇒ Some (v#vs)
| _ ⇒ None)
| _ ⇒ None)" |
"map_vals_of [] = Some []"
lemma map_vals_of_spec: "map_vals_of es = Some vs ⟹ es = map Val vs"
proof(induct es arbitrary: vs) qed(auto simp: val_of_spec)
lemma map_vals_of_Vals[simp]: "map_vals_of (map Val vs) = ⌊vs⌋" by(induct vs, auto)
lemma map_vals_of_throw[simp]:
"map_vals_of (map Val vs @ throw e # es') = None"
by(induct vs, auto)
fun bool_of :: "'a exp ⇒ bool option" where
"bool_of true = Some True" |
"bool_of false = Some False" |
"bool_of _ = None"
lemma bool_of_specT:
assumes "bool_of e = Some True" shows "e = true"
proof -
have "bool_of e = Some True" by fact
then show ?thesis
proof(cases e)
case (Val x3) with assms show ?thesis
proof(cases x3)
case (Bool x) with assms Val show ?thesis
proof(cases x)qed(auto)
qed(simp_all)
qed(auto)
qed
lemma bool_of_specF:
assumes "bool_of e = Some False" shows "e = false"
proof -
have "bool_of e = Some False" by fact
then show ?thesis
proof(cases e)
case (Val x3) with assms show ?thesis
proof(cases x3)
case (Bool x) with assms Val show ?thesis
proof(cases x)qed(auto)
qed(simp_all)
qed(auto)
qed
fun throw_of :: "'a exp ⇒ 'a exp option" where
"throw_of (throw e') = Some e'" |
"throw_of _ = None"
lemma throw_of_spec: "throw_of e = Some e' ⟹ e = throw e'"
proof(cases e) qed(auto)
fun init_exp_of :: "'a exp ⇒ 'a exp option" where
"init_exp_of (INIT C (Cs,b) ← e) = Some e" |
"init_exp_of (RI(C,e');Cs ← e) = Some e" |
"init_exp_of _ = None"
lemma init_exp_of_neq [simp]: "init_exp_of e = ⌊e'⌋ ⟹ e' ≠ e" by(cases e, auto)
lemma init_exp_of_neq'[simp]: "init_exp_of e = ⌊e'⌋ ⟹ e ≠ e'" by(cases e, auto)
subsection‹Class initialization›
text ‹ This section defines a few functions that return information
about an expression's current initialization status. ›
primrec sub_RI :: "'a exp ⇒ bool" and sub_RIs :: "'a exp list ⇒ bool" where
"sub_RI(new C) = False"
| "sub_RI(Cast C e) = sub_RI e"
| "sub_RI(Val v) = False"
| "sub_RI(e⇩1 «bop» e⇩2) = (sub_RI e⇩1 ∨ sub_RI e⇩2)"
| "sub_RI(Var V) = False"
| "sub_RI(LAss V e) = sub_RI e"
| "sub_RI(e∙F{D}) = sub_RI e"
| "sub_RI(C∙⇩sF{D}) = False"
| "sub_RI(e⇩1∙F{D}:=e⇩2) = (sub_RI e⇩1 ∨ sub_RI e⇩2)"
| "sub_RI(C∙⇩sF{D}:=e⇩2) = sub_RI e⇩2"
| "sub_RI(e∙M(es)) = (sub_RI e ∨ sub_RIs es)"
| "sub_RI(C∙⇩sM(es)) = (M = clinit ∨ sub_RIs es)"
| "sub_RI({V:T; e}) = sub_RI e"
| "sub_RI(e⇩1;;e⇩2) = (sub_RI e⇩1 ∨ sub_RI e⇩2)"
| "sub_RI(if (b) e⇩1 else e⇩2) = (sub_RI b ∨ sub_RI e⇩1 ∨ sub_RI e⇩2)"
| "sub_RI(while (b) e) = (sub_RI b ∨ sub_RI e)"
| "sub_RI(throw e) = sub_RI e"
| "sub_RI(try e⇩1 catch(C V) e⇩2) = (sub_RI e⇩1 ∨ sub_RI e⇩2)"
| "sub_RI(INIT C (Cs,b) ← e) = True"
| "sub_RI(RI (C,e);Cs ← e') = True"
| "sub_RIs([]) = False"
| "sub_RIs(e#es) = (sub_RI e ∨ sub_RIs es)"
lemmas sub_RI_sub_RIs_induct = sub_RI.induct sub_RIs.induct
lemma nsub_RIs_def[simp]:
"¬sub_RIs es ⟹ ∀e ∈ set es. ¬sub_RI e"
by(induct es, auto)
lemma sub_RI_base:
"e = INIT C (Cs, b) ← e' ∨ e = RI(C,e⇩0);Cs ← e' ⟹ sub_RI e"
by(cases e, auto)
lemma nsub_RI_Vals[simp]: "¬sub_RIs (map Val vs)"
by(induct vs, auto)
lemma lass_val_of_nsub_RI: "lass_val_of e = ⌊a⌋ ⟹ ¬sub_RI e"
by(drule lass_val_of_spec, simp)
primrec not_init :: "cname ⇒ 'a exp ⇒ bool" and not_inits :: "cname ⇒ 'a exp list ⇒ bool" where
"not_init C' (new C) = True"
| "not_init C' (Cast C e) = not_init C' e"
| "not_init C' (Val v) = True"
| "not_init C' (e⇩1 «bop» e⇩2) = (not_init C' e⇩1 ∧ not_init C' e⇩2)"
| "not_init C' (Var V) = True"
| "not_init C' (LAss V e) = not_init C' e"
| "not_init C' (e∙F{D}) = not_init C' e"
| "not_init C' (C∙⇩sF{D}) = True"
| "not_init C' (e⇩1∙F{D}:=e⇩2) = (not_init C' e⇩1 ∧ not_init C' e⇩2)"
| "not_init C' (C∙⇩sF{D}:=e⇩2) = not_init C' e⇩2"
| "not_init C' (e∙M(es)) = (not_init C' e ∧ not_inits C' es)"
| "not_init C' (C∙⇩sM(es)) = not_inits C' es"
| "not_init C' ({V:T; e}) = not_init C' e"
| "not_init C' (e⇩1;;e⇩2) = (not_init C' e⇩1 ∧ not_init C' e⇩2)"
| "not_init C' (if (b) e⇩1 else e⇩2) = (not_init C' b ∧ not_init C' e⇩1 ∧ not_init C' e⇩2)"
| "not_init C' (while (b) e) = (not_init C' b ∧ not_init C' e)"
| "not_init C' (throw e) = not_init C' e"
| "not_init C' (try e⇩1 catch(C V) e⇩2) = (not_init C' e⇩1 ∧ not_init C' e⇩2)"
| "not_init C' (INIT C (Cs,b) ← e) = ((b ⟶ Cs = Nil ∨ C' ≠ hd Cs) ∧ C' ∉ set(tl Cs) ∧ not_init C' e)"
| "not_init C' (RI (C,e);Cs ← e') = (C' ∉ set (C#Cs) ∧ not_init C' e ∧ not_init C' e')"
| "not_inits C' ([]) = True"
| "not_inits C' (e#es) = (not_init C' e ∧ not_inits C' es)"
lemma not_inits_def'[simp]:
"not_inits C es ⟹ ∀e ∈ set es. not_init C e"
by(induct es, auto)
lemma nsub_RIs_not_inits_aux: "∀e ∈ set es. ¬sub_RI e ⟶ not_init C e
⟹ ¬sub_RIs es ⟹ not_inits C es"
by(induct es, auto)
lemma nsub_RI_not_init: "¬sub_RI e ⟹ not_init C e"
proof(induct e) qed(auto intro: nsub_RIs_not_inits_aux)
lemma nsub_RIs_not_inits: "¬sub_RIs es ⟹ not_inits C es"
apply(rule nsub_RIs_not_inits_aux)
apply(simp_all add: nsub_RI_not_init)
done
subsection‹Subexpressions›
primrec subexp :: "'a exp ⇒ 'a exp set" and subexps :: "'a exp list ⇒ 'a exp set" where
"subexp(new C) = {}"
| "subexp(Cast C e) = {e} ∪ subexp e"
| "subexp(Val v) = {}"
| "subexp(e⇩1 «bop» e⇩2) = {e⇩1, e⇩2} ∪ subexp e⇩1 ∪ subexp e⇩2"
| "subexp(Var V) = {}"
| "subexp(LAss V e) = {e} ∪ subexp e"
| "subexp(e∙F{D}) = {e} ∪ subexp e"
| "subexp(C∙⇩sF{D}) = {}"
| "subexp(e⇩1∙F{D}:=e⇩2) = {e⇩1, e⇩2} ∪ subexp e⇩1 ∪ subexp e⇩2"
| "subexp(C∙⇩sF{D}:=e⇩2) = {e⇩2} ∪subexp e⇩2"
| "subexp(e∙M(es)) = {e} ∪ set es ∪ subexp e ∪ subexps es"
| "subexp(C∙⇩sM(es)) = set es ∪ subexps es"
| "subexp({V:T; e}) = {e} ∪ subexp e"
| "subexp(e⇩1;;e⇩2) = {e⇩1, e⇩2} ∪ subexp e⇩1 ∪ subexp e⇩2"
| "subexp(if (b) e⇩1 else e⇩2) = {b, e⇩1, e⇩2} ∪ subexp b ∪ subexp e⇩1 ∪ subexp e⇩2"
| "subexp(while (b) e) = {b, e} ∪ subexp b ∪ subexp e"
| "subexp(throw e) = {e} ∪ subexp e"
| "subexp(try e⇩1 catch(C V) e⇩2) = {e⇩1, e⇩2} ∪ subexp e⇩1 ∪ subexp e⇩2"
| "subexp(INIT C (Cs,b) ← e) = {e} ∪ subexp e"
| "subexp(RI (C,e);Cs ← e') = {e, e'} ∪ subexp e ∪ subexp e'"
| "subexps([]) = {}"
| "subexps(e#es) = {e} ∪ subexp e ∪ subexps es"
lemmas subexp_subexps_induct = subexp.induct subexps.induct
abbreviation subexp_of :: "'a exp ⇒ 'a exp ⇒ bool" where
"subexp_of e e' ≡ e ∈ subexp e'"
lemma subexp_size_le:
"(e' ∈ subexp e ⟶ size e' < size e) ∧ (e' ∈ subexps es ⟶ size e' < size_list size es)"
proof(induct rule: subexp_subexps.induct)
case Call:11 then show ?case using not_less_eq size_list_estimation by fastforce
next
case SCall:12 then show ?case using not_less_eq size_list_estimation by fastforce
qed(auto)
lemma subexps_def2: "subexps es = set es ∪ (⋃e ∈ set es. subexp e)" by(induct es, auto)
lemma shows subexp_induct[consumes 1]:
"(⋀e. subexp e = {} ⟹ R e) ⟹ (⋀e. (⋀e'. e' ∈ subexp e ⟹ R e') ⟹ R e)
⟹ (⋀es. (⋀e'. e' ∈ subexps es ⟹ R e') ⟹ Rs es) ⟹ (∀e'. e' ∈ subexp e ⟶ R e') ∧ R e"
and subexps_induct[consumes 1]:
"(⋀es. subexps es = {} ⟹ Rs es) ⟹ (⋀e. (⋀e'. e' ∈ subexp e ⟹ R e') ⟹ R e)
⟹ (⋀es. (⋀e'. e' ∈ subexps es ⟹ R e') ⟹ Rs es) ⟹ (∀e'. e' ∈ subexps es ⟶ R e') ∧ Rs es"
proof(induct rule: subexp_subexps_induct)
case (Cast x1 x2)
then have "(∀e'. subexp_of e' x2 ⟶ R e') ∧ R x2" by fast
then have "(∀e'. subexp_of e' (Cast x1 x2) ⟶ R e')" by auto
then show ?case using Cast.prems(2) by fast
next
case (BinOp x1 x2 x3)
then have "(∀e'. subexp_of e' x1 ⟶ R e') ∧ R x1" and "(∀e'. subexp_of e' x3 ⟶ R e') ∧ R x3"
by fast+
then have "(∀e'. subexp_of e' (x1 «x2» x3) ⟶ R e')" by auto
then show ?case using BinOp.prems(2) by fast
next
case (LAss x1 x2)
then have "(∀e'. subexp_of e' x2 ⟶ R e') ∧ R x2" by fast
then have "(∀e'. subexp_of e' (LAss x1 x2) ⟶ R e')" by auto
then show ?case using LAss.prems(2) by fast
next
case (FAcc x1 x2 x3)
then have "(∀e'. subexp_of e' x1 ⟶ R e') ∧ R x1" by fast
then have "(∀e'. subexp_of e' (x1∙x2{x3}) ⟶ R e')" by auto
then show ?case using FAcc.prems(2) by fast
next
case (FAss x1 x2 x3 x4)
then have "(∀e'. subexp_of e' x1 ⟶ R e') ∧ R x1" and "(∀e'. subexp_of e' x4 ⟶ R e') ∧ R x4"
by fast+
then have "(∀e'. subexp_of e' (x1∙x2{x3} := x4) ⟶ R e')" by auto
then show ?case using FAss.prems(2) by fast
next
case (SFAss x1 x2 x3 x4)
then have "(∀e'. subexp_of e' x4 ⟶ R e') ∧ R x4" by fast
then have "(∀e'. subexp_of e' (x1∙⇩sx2{x3} := x4) ⟶ R e')" by auto
then show ?case using SFAss.prems(2) by fast
next
case (Call x1 x2 x3)
then have "(∀e'. subexp_of e' x1 ⟶ R e') ∧ R x1" and "(∀e'. e' ∈ subexps x3 ⟶ R e') ∧ Rs x3"
by fast+
then have "(∀e'. subexp_of e' (x1∙x2(x3)) ⟶ R e')" using subexps_def2 by auto
then show ?case using Call.prems(2) by fast
next
case (SCall x1 x2 x3)
then have "(∀e'. e' ∈ subexps x3 ⟶ R e') ∧ Rs x3" by fast
then have "(∀e'. subexp_of e' (x1∙⇩sx2(x3)) ⟶ R e')" using subexps_def2 by auto
then show ?case using SCall.prems(2) by fast
next
case (Block x1 x2 x3)
then have "(∀e'. subexp_of e' x3 ⟶ R e') ∧ R x3" by fast
then have "(∀e'. subexp_of e' {x1:x2; x3} ⟶ R e')" by auto
then show ?case using Block.prems(2) by fast
next
case (Seq x1 x2)
then have "(∀e'. subexp_of e' x1 ⟶ R e') ∧ R x1" and "(∀e'. subexp_of e' x2 ⟶ R e') ∧ R x2"
by fast+
then have "(∀e'. subexp_of e' (x1;; x2) ⟶ R e')" by auto
then show ?case using Seq.prems(2) by fast
next
case (Cond x1 x2 x3)
then have "(∀e'. subexp_of e' x1 ⟶ R e') ∧ R x1" and "(∀e'. subexp_of e' x2 ⟶ R e') ∧ R x2"
and "(∀e'. subexp_of e' x3 ⟶ R e') ∧ R x3" by fast+
then have "(∀e'. subexp_of e' (if (x1) x2 else x3) ⟶ R e')" by auto
then show ?case using Cond.prems(2) by fast
next
case (While x1 x2)
then have "(∀e'. subexp_of e' x1 ⟶ R e') ∧ R x1" and "(∀e'. subexp_of e' x2 ⟶ R e') ∧ R x2"
by fast+
then have "(∀e'. subexp_of e' (while (x1) x2) ⟶ R e')" by auto
then show ?case using While.prems(2) by fast
next
case (throw x)
then have "(∀e'. subexp_of e' x ⟶ R e') ∧ R x" by fast
then have "(∀e'. subexp_of e' (throw x) ⟶ R e')" by auto
then show ?case using throw.prems(2) by fast
next
case (TryCatch x1 x2 x3 x4)
then have "(∀e'. subexp_of e' x1 ⟶ R e') ∧ R x1" and "(∀e'. subexp_of e' x4 ⟶ R e') ∧ R x4"
by fast+
then have "(∀e'. subexp_of e' (try x1 catch(x2 x3) x4) ⟶ R e')" by auto
then show ?case using TryCatch.prems(2) by fast
next
case (INIT x1 x2 x3 x4)
then have "(∀e'. subexp_of e' x4 ⟶ R e') ∧ R x4" by fast
then have "(∀e'. subexp_of e' (INIT x1 (x2,x3) ← x4) ⟶ R e')" by auto
then show ?case using INIT.prems(2) by fast
next
case (RI x1 x2 x3 x4)
then have "(∀e'. subexp_of e' x2 ⟶ R e') ∧ R x2" and "(∀e'. subexp_of e' x4 ⟶ R e') ∧ R x4"
by fast+
then have "(∀e'. subexp_of e' (RI (x1,x2) ; x3 ← x4) ⟶ R e')" by auto
then show ?case using RI.prems(2) by fast
next
case (Cons_exp x1 x2)
then have "(∀e'. subexp_of e' x1 ⟶ R e') ∧ R x1" and "(∀e'. e' ∈ subexps x2 ⟶ R e') ∧ Rs x2"
by fast+
then have "(∀e'. e' ∈ subexps (x1 # x2) ⟶ R e')" using subexps_def2 by auto
then show ?case using Cons_exp.prems(3) by fast
qed(auto)
subsection"Final expressions"
definition final :: "'a exp ⇒ bool"
where
"final e ≡ (∃v. e = Val v) ∨ (∃a. e = Throw a)"
definition finals:: "'a exp list ⇒ bool"
where
"finals es ≡ (∃vs. es = map Val vs) ∨ (∃vs a es'. es = map Val vs @ Throw a # es')"
lemma [simp]: "final(Val v)"
by(simp add:final_def)
lemma [simp]: "final(throw e) = (∃a. e = addr a)"
by(simp add:final_def)
lemma finalE: "⟦ final e; ⋀v. e = Val v ⟹ R; ⋀a. e = Throw a ⟹ R ⟧ ⟹ R"
by(auto simp:final_def)
lemma final_fv[iff]: "final e ⟹ fv e = {}"
by (auto simp: final_def)
lemma finalsE:
"⟦ finals es; ⋀vs. es = map Val vs ⟹ R; ⋀vs a es'. es = map Val vs @ Throw a # es' ⟹ R ⟧ ⟹ R"
by(auto simp:finals_def)
lemma [iff]: "finals []"
by(simp add:finals_def)
lemma [iff]: "finals (Val v # es) = finals es"
apply(clarsimp simp add: finals_def)
apply(rule iffI)
apply(erule disjE)
apply simp
apply(rule disjI2)
apply clarsimp
apply(case_tac vs)
apply simp
apply fastforce
apply(erule disjE)
apply clarsimp
apply(rule disjI2)
apply clarsimp
apply(rule_tac x = "v#vs" in exI)
apply simp
done
lemma finals_app_map[iff]: "finals (map Val vs @ es) = finals es"
by(induct_tac vs, auto)
lemma [iff]: "finals (map Val vs)"
using finals_app_map[of vs "[]"]by(simp)
lemma [iff]: "finals (throw e # es) = (∃a. e = addr a)"
apply(simp add:finals_def)
apply(rule iffI)
apply clarsimp
apply(case_tac vs)
apply simp
apply fastforce
apply clarsimp
apply(rule_tac x = "[]" in exI)
apply simp
done
lemma not_finals_ConsI: "¬ final e ⟹ ¬ finals(e#es)"
apply(clarsimp simp add:finals_def final_def)
apply(case_tac vs)
apply auto
done
lemma not_finals_ConsI2: "e = Val v ⟹ ¬ finals es ⟹ ¬ finals(e#es)"
apply(clarsimp simp add:finals_def final_def)
apply(case_tac vs)
apply auto
done
end
Theory WellType
section ‹ Well-typedness of Jinja expressions ›
theory WellType
imports "../Common/Objects" Expr
begin
type_synonym
env = "vname ⇀ ty"
inductive
WT :: "[J_prog,env, expr , ty ] ⇒ bool"
("_,_ ⊢ _ :: _" [51,51,51]50)
and WTs :: "[J_prog,env, expr list, ty list] ⇒ bool"
("_,_ ⊢ _ [::] _" [51,51,51]50)
for P :: J_prog
where
WTNew:
"is_class P C ⟹
P,E ⊢ new C :: Class C"
| WTCast:
"⟦ P,E ⊢ e :: Class D; is_class P C; P ⊢ C ≼⇧* D ∨ P ⊢ D ≼⇧* C ⟧
⟹ P,E ⊢ Cast C e :: Class C"
| WTVal:
"typeof v = Some T ⟹
P,E ⊢ Val v :: T"
| WTVar:
"E V = Some T ⟹
P,E ⊢ Var V :: T"
| WTBinOpEq:
"⟦ P,E ⊢ e⇩1 :: T⇩1; P,E ⊢ e⇩2 :: T⇩2; P ⊢ T⇩1 ≤ T⇩2 ∨ P ⊢ T⇩2 ≤ T⇩1 ⟧
⟹ P,E ⊢ e⇩1 «Eq» e⇩2 :: Boolean"
| WTBinOpAdd:
"⟦ P,E ⊢ e⇩1 :: Integer; P,E ⊢ e⇩2 :: Integer ⟧
⟹ P,E ⊢ e⇩1 «Add» e⇩2 :: Integer"
| WTLAss:
"⟦ E V = Some T; P,E ⊢ e :: T'; P ⊢ T' ≤ T; V ≠ this ⟧
⟹ P,E ⊢ V:=e :: Void"
| WTFAcc:
"⟦ P,E ⊢ e :: Class C; P ⊢ C sees F,NonStatic:T in D ⟧
⟹ P,E ⊢ e∙F{D} :: T"
| WTSFAcc:
"⟦ P ⊢ C sees F,Static:T in D ⟧
⟹ P,E ⊢ C∙⇩sF{D} :: T"
| WTFAss:
"⟦ P,E ⊢ e⇩1 :: Class C; P ⊢ C sees F,NonStatic:T in D; P,E ⊢ e⇩2 :: T'; P ⊢ T' ≤ T ⟧
⟹ P,E ⊢ e⇩1∙F{D}:=e⇩2 :: Void"
| WTSFAss:
"⟦ P ⊢ C sees F,Static:T in D; P,E ⊢ e⇩2 :: T'; P ⊢ T' ≤ T ⟧
⟹ P,E ⊢ C∙⇩sF{D}:=e⇩2 :: Void"
| WTCall:
"⟦ P,E ⊢ e :: Class C; P ⊢ C sees M,NonStatic:Ts → T = (pns,body) in D;
P,E ⊢ es [::] Ts'; P ⊢ Ts' [≤] Ts ⟧
⟹ P,E ⊢ e∙M(es) :: T"
| WTSCall:
"⟦ P ⊢ C sees M,Static:Ts → T = (pns,body) in D;
P,E ⊢ es [::] Ts'; P ⊢ Ts' [≤] Ts; M ≠ clinit ⟧
⟹ P,E ⊢ C∙⇩sM(es) :: T"
| WTBlock:
"⟦ is_type P T; P,E(V ↦ T) ⊢ e :: T' ⟧
⟹ P,E ⊢ {V:T; e} :: T'"
| WTSeq:
"⟦ P,E ⊢ e⇩1::T⇩1; P,E ⊢ e⇩2::T⇩2 ⟧
⟹ P,E ⊢ e⇩1;;e⇩2 :: T⇩2"
| WTCond:
"⟦ P,E ⊢ e :: Boolean; P,E ⊢ e⇩1::T⇩1; P,E ⊢ e⇩2::T⇩2;
P ⊢ T⇩1 ≤ T⇩2 ∨ P ⊢ T⇩2 ≤ T⇩1; P ⊢ T⇩1 ≤ T⇩2 ⟶ T = T⇩2; P ⊢ T⇩2 ≤ T⇩1 ⟶ T = T⇩1 ⟧
⟹ P,E ⊢ if (e) e⇩1 else e⇩2 :: T"
| WTWhile:
"⟦ P,E ⊢ e :: Boolean; P,E ⊢ c::T ⟧
⟹ P,E ⊢ while (e) c :: Void"
| WTThrow:
"P,E ⊢ e :: Class C ⟹
P,E ⊢ throw e :: Void"
| WTTry:
"⟦ P,E ⊢ e⇩1 :: T; P,E(V ↦ Class C) ⊢ e⇩2 :: T; is_class P C ⟧
⟹ P,E ⊢ try e⇩1 catch(C V) e⇩2 :: T"
| WTNil:
"P,E ⊢ [] [::] []"
| WTCons:
"⟦ P,E ⊢ e :: T; P,E ⊢ es [::] Ts ⟧
⟹ P,E ⊢ e#es [::] T#Ts"
declare WT_WTs.intros[intro!]
lemmas WT_WTs_induct = WT_WTs.induct [split_format (complete)]
and WT_WTs_inducts = WT_WTs.inducts [split_format (complete)]
lemma init_nwt [simp]:"¬P,E ⊢ INIT C (Cs,b) ← e :: T"
by(auto elim:WT.cases)
lemma ri_nwt [simp]:"¬P,E ⊢ RI(C,e);Cs ← e' :: T"
by(auto elim:WT.cases)
lemma [iff]: "(P,E ⊢ [] [::] Ts) = (Ts = [])"
apply(rule iffI)
apply (auto elim: WTs.cases)
done
lemma [iff]: "(P,E ⊢ e#es [::] T#Ts) = (P,E ⊢ e :: T ∧ P,E ⊢ es [::] Ts)"
apply(rule iffI)
apply (auto elim: WTs.cases)
done
lemma [iff]: "(P,E ⊢ (e#es) [::] Ts) =
(∃U Us. Ts = U#Us ∧ P,E ⊢ e :: U ∧ P,E ⊢ es [::] Us)"
apply(rule iffI)
apply (auto elim: WTs.cases)
done
lemma [iff]: "⋀Ts. (P,E ⊢ es⇩1 @ es⇩2 [::] Ts) =
(∃Ts⇩1 Ts⇩2. Ts = Ts⇩1 @ Ts⇩2 ∧ P,E ⊢ es⇩1 [::] Ts⇩1 ∧ P,E ⊢ es⇩2[::]Ts⇩2)"
apply(induct es⇩1 type:list)
apply simp
apply clarsimp
apply(erule thin_rl)
apply (rule iffI)
apply clarsimp
apply(rule exI)+
apply(rule conjI)
prefer 2 apply blast
apply simp
apply fastforce
done
lemma [iff]: "P,E ⊢ Val v :: T = (typeof v = Some T)"
apply(rule iffI)
apply (auto elim: WT.cases)
done
lemma [iff]: "P,E ⊢ Var V :: T = (E V = Some T)"
apply(rule iffI)
apply (auto elim: WT.cases)
done
lemma [iff]: "P,E ⊢ e⇩1;;e⇩2 :: T⇩2 = (∃T⇩1. P,E ⊢ e⇩1::T⇩1 ∧ P,E ⊢ e⇩2::T⇩2)"
apply(rule iffI)
apply (auto elim: WT.cases)
done
lemma [iff]: "(P,E ⊢ {V:T; e} :: T') = (is_type P T ∧ P,E(V↦T) ⊢ e :: T')"
apply(rule iffI)
apply (auto elim: WT.cases)
done
inductive_cases WT_elim_cases[elim!]:
"P,E ⊢ V :=e :: T"
"P,E ⊢ if (e) e⇩1 else e⇩2 :: T"
"P,E ⊢ while (e) c :: T"
"P,E ⊢ throw e :: T"
"P,E ⊢ try e⇩1 catch(C V) e⇩2 :: T"
"P,E ⊢ Cast D e :: T"
"P,E ⊢ a∙F{D} :: T"
"P,E ⊢ C∙⇩sF{D} :: T"
"P,E ⊢ a∙F{D} := v :: T"
"P,E ⊢ C∙⇩sF{D} := v :: T"
"P,E ⊢ e⇩1 «bop» e⇩2 :: T"
"P,E ⊢ new C :: T"
"P,E ⊢ e∙M(ps) :: T"
"P,E ⊢ C∙⇩sM(ps) :: T"
lemma wt_env_mono:
"P,E ⊢ e :: T ⟹ (⋀E'. E ⊆⇩m E' ⟹ P,E' ⊢ e :: T)" and
"P,E ⊢ es [::] Ts ⟹ (⋀E'. E ⊆⇩m E' ⟹ P,E' ⊢ es [::] Ts)"
apply(induct rule: WT_WTs_inducts)
apply(simp add: WTNew)
apply(fastforce simp: WTCast)
apply(fastforce simp: WTVal)
apply(simp add: WTVar map_le_def dom_def)
apply(fastforce simp: WTBinOpEq)
apply(fastforce simp: WTBinOpAdd)
apply(force simp:map_le_def)
apply(fastforce simp: WTFAcc)
apply(fastforce)
apply(fastforce simp: WTFAss del:WT_WTs.intros WT_elim_cases)
apply(fastforce)
apply(fastforce simp: WTCall)
apply(fastforce)
apply(fastforce simp: map_le_def WTBlock)
apply(fastforce simp: WTSeq)
apply(fastforce simp: WTCond)
apply(fastforce simp: WTWhile)
apply(fastforce simp: WTThrow)
apply(fastforce simp: WTTry map_le_def dom_def)
apply(simp add: WTNil)
apply(simp add: WTCons)
done
lemma WT_fv: "P,E ⊢ e :: T ⟹ fv e ⊆ dom E"
and "P,E ⊢ es [::] Ts ⟹ fvs es ⊆ dom E"
apply(induct rule:WT_WTs.inducts)
apply(simp_all del: fun_upd_apply)
apply fast+
done
lemma WT_nsub_RI: "P,E ⊢ e :: T ⟹ ¬sub_RI e"
and WTs_nsub_RIs: "P,E ⊢ es [::] Ts ⟹ ¬sub_RIs es"
proof(induct rule: WT_WTs.inducts) qed(simp_all)
end
Theory WellTypeRT
section ‹ Runtime Well-typedness ›
theory WellTypeRT
imports WellType
begin
inductive
WTrt :: "J_prog ⇒ heap ⇒ sheap ⇒ env ⇒ expr ⇒ ty ⇒ bool"
and WTrts :: "J_prog ⇒ heap ⇒ sheap ⇒ env ⇒ expr list ⇒ ty list ⇒ bool"
and WTrt2 :: "[J_prog,env,heap,sheap,expr,ty] ⇒ bool"
("_,_,_,_ ⊢ _ : _" [51,51,51,51]50)
and WTrts2 :: "[J_prog,env,heap,sheap,expr list, ty list] ⇒ bool"
("_,_,_,_ ⊢ _ [:] _" [51,51,51,51]50)
for P :: J_prog and h :: heap and sh :: sheap
where
"P,E,h,sh ⊢ e : T ≡ WTrt P h sh E e T"
| "P,E,h,sh ⊢ es[:]Ts ≡ WTrts P h sh E es Ts"
| WTrtNew:
"is_class P C ⟹
P,E,h,sh ⊢ new C : Class C"
| WTrtCast:
"⟦ P,E,h,sh ⊢ e : T; is_refT T; is_class P C ⟧
⟹ P,E,h,sh ⊢ Cast C e : Class C"
| WTrtVal:
"typeof⇘h⇙ v = Some T ⟹
P,E,h,sh ⊢ Val v : T"
| WTrtVar:
"E V = Some T ⟹
P,E,h,sh ⊢ Var V : T"
| WTrtBinOpEq:
"⟦ P,E,h,sh ⊢ e⇩1 : T⇩1; P,E,h,sh ⊢ e⇩2 : T⇩2 ⟧
⟹ P,E,h,sh ⊢ e⇩1 «Eq» e⇩2 : Boolean"
| WTrtBinOpAdd:
"⟦ P,E,h,sh ⊢ e⇩1 : Integer; P,E,h,sh ⊢ e⇩2 : Integer ⟧
⟹ P,E,h,sh ⊢ e⇩1 «Add» e⇩2 : Integer"
| WTrtLAss:
"⟦ E V = Some T; P,E,h,sh ⊢ e : T'; P ⊢ T' ≤ T ⟧
⟹ P,E,h,sh ⊢ V:=e : Void"
| WTrtFAcc:
"⟦ P,E,h,sh ⊢ e : Class C; P ⊢ C has F,NonStatic:T in D ⟧ ⟹
P,E,h,sh ⊢ e∙F{D} : T"
| WTrtFAccNT:
"P,E,h,sh ⊢ e : NT ⟹
P,E,h,sh ⊢ e∙F{D} : T"
| WTrtSFAcc:
"⟦ P ⊢ C has F,Static:T in D ⟧ ⟹
P,E,h,sh ⊢ C∙⇩sF{D} : T"
| WTrtFAss:
"⟦ P,E,h,sh ⊢ e⇩1 : Class C; P ⊢ C has F,NonStatic:T in D; P,E,h,sh ⊢ e⇩2 : T⇩2; P ⊢ T⇩2 ≤ T ⟧
⟹ P,E,h,sh ⊢ e⇩1∙F{D}:=e⇩2 : Void"
| WTrtFAssNT:
"⟦ P,E,h,sh ⊢ e⇩1:NT; P,E,h,sh ⊢ e⇩2 : T⇩2 ⟧
⟹ P,E,h,sh ⊢ e⇩1∙F{D}:=e⇩2 : Void"
| WTrtSFAss:
"⟦ P,E,h,sh ⊢ e⇩2 : T⇩2; P ⊢ C has F,Static:T in D; P ⊢ T⇩2 ≤ T ⟧
⟹ P,E,h,sh ⊢ C∙⇩sF{D}:=e⇩2 : Void"
| WTrtCall:
"⟦ P,E,h,sh ⊢ e : Class C; P ⊢ C sees M,NonStatic:Ts → T = (pns,body) in D;
P,E,h,sh ⊢ es [:] Ts'; P ⊢ Ts' [≤] Ts ⟧
⟹ P,E,h,sh ⊢ e∙M(es) : T"
| WTrtCallNT:
"⟦ P,E,h,sh ⊢ e : NT; P,E,h,sh ⊢ es [:] Ts ⟧
⟹ P,E,h,sh ⊢ e∙M(es) : T"
| WTrtSCall:
"⟦ P ⊢ C sees M,Static:Ts → T = (pns,body) in D;
P,E,h,sh ⊢ es [:] Ts'; P ⊢ Ts' [≤] Ts;
M = clinit ⟶ sh D = ⌊(sfs,Processing)⌋ ∧ es = map Val vs ⟧
⟹ P,E,h,sh ⊢ C∙⇩sM(es) : T"
| WTrtBlock:
"P,E(V↦T),h,sh ⊢ e : T' ⟹
P,E,h,sh ⊢ {V:T; e} : T'"
| WTrtSeq:
"⟦ P,E,h,sh ⊢ e⇩1:T⇩1; P,E,h,sh ⊢ e⇩2:T⇩2 ⟧
⟹ P,E,h,sh ⊢ e⇩1;;e⇩2 : T⇩2"
| WTrtCond:
"⟦ P,E,h,sh ⊢ e : Boolean; P,E,h,sh ⊢ e⇩1:T⇩1; P,E,h,sh ⊢ e⇩2:T⇩2;
P ⊢ T⇩1 ≤ T⇩2 ∨ P ⊢ T⇩2 ≤ T⇩1; P ⊢ T⇩1 ≤ T⇩2 ⟶ T = T⇩2; P ⊢ T⇩2 ≤ T⇩1 ⟶ T = T⇩1 ⟧
⟹ P,E,h,sh ⊢ if (e) e⇩1 else e⇩2 : T"
| WTrtWhile:
"⟦ P,E,h,sh ⊢ e : Boolean; P,E,h,sh ⊢ c:T ⟧
⟹ P,E,h,sh ⊢ while(e) c : Void"
| WTrtThrow:
"⟦ P,E,h,sh ⊢ e : T⇩r; is_refT T⇩r ⟧ ⟹
P,E,h,sh ⊢ throw e : T"
| WTrtTry:
"⟦ P,E,h,sh ⊢ e⇩1 : T⇩1; P,E(V ↦ Class C),h,sh ⊢ e⇩2 : T⇩2; P ⊢ T⇩1 ≤ T⇩2 ⟧
⟹ P,E,h,sh ⊢ try e⇩1 catch(C V) e⇩2 : T⇩2"
| WTrtInit:
"⟦ P,E,h,sh ⊢ e : T; ∀C' ∈ set (C#Cs). is_class P C'; ¬sub_RI e;
∀C' ∈ set (tl Cs). ∃sfs. sh C' = ⌊(sfs,Processing)⌋;
b ⟶ (∀C' ∈ set Cs. ∃sfs. sh C' = ⌊(sfs,Processing)⌋);
distinct Cs; supercls_lst P Cs ⟧
⟹ P,E,h,sh ⊢ INIT C (Cs, b) ← e : T"
| WTrtRI:
"⟦ P,E,h,sh ⊢ e : T; P,E,h,sh ⊢ e' : T'; ∀C' ∈ set (C#Cs). is_class P C'; ¬sub_RI e';
∀C' ∈ set (C#Cs). not_init C' e;
∀C' ∈ set Cs. ∃sfs. sh C' = ⌊(sfs,Processing)⌋;
∃sfs. sh C = ⌊(sfs, Processing)⌋ ∨ (sh C = ⌊(sfs, Error)⌋ ∧ e = THROW NoClassDefFoundError);
distinct (C#Cs); supercls_lst P (C#Cs) ⟧
⟹ P,E,h,sh ⊢ RI(C, e);Cs ← e' : T'"
| WTrtNil:
"P,E,h,sh ⊢ [] [:] []"
| WTrtCons:
"⟦ P,E,h,sh ⊢ e : T; P,E,h,sh ⊢ es [:] Ts ⟧
⟹ P,E,h,sh ⊢ e#es [:] T#Ts"
declare WTrt_WTrts.intros[intro!] WTrtNil[iff]
declare
WTrtFAcc[rule del] WTrtFAccNT[rule del] WTrtSFAcc[rule del]
WTrtFAss[rule del] WTrtFAssNT[rule del] WTrtSFAss[rule del]
WTrtCall[rule del] WTrtCallNT[rule del] WTrtSCall[rule del]
lemmas WTrt_induct = WTrt_WTrts.induct [split_format (complete)]
and WTrt_inducts = WTrt_WTrts.inducts [split_format (complete)]
subsection‹Easy consequences›
lemma [iff]: "(P,E,h,sh ⊢ [] [:] Ts) = (Ts = [])"
apply(rule iffI)
apply (auto elim: WTrts.cases)
done
lemma [iff]: "(P,E,h,sh ⊢ e#es [:] T#Ts) = (P,E,h,sh ⊢ e : T ∧ P,E,h,sh ⊢ es [:] Ts)"
apply(rule iffI)
apply (auto elim: WTrts.cases)
done
lemma [iff]: "(P,E,h,sh ⊢ (e#es) [:] Ts) =
(∃U Us. Ts = U#Us ∧ P,E,h,sh ⊢ e : U ∧ P,E,h,sh ⊢ es [:] Us)"
apply(rule iffI)
apply (auto elim: WTrts.cases)
done
lemma [simp]: "∀Ts. (P,E,h,sh ⊢ es⇩1 @ es⇩2 [:] Ts) =
(∃Ts⇩1 Ts⇩2. Ts = Ts⇩1 @ Ts⇩2 ∧ P,E,h,sh ⊢ es⇩1 [:] Ts⇩1 & P,E,h,sh ⊢ es⇩2[:]Ts⇩2)"
apply(induct_tac es⇩1)
apply simp
apply clarsimp
apply(erule thin_rl)
apply (rule iffI)
apply clarsimp
apply(rule exI)+
apply(rule conjI)
prefer 2 apply blast
apply simp
apply fastforce
done
lemma [iff]: "P,E,h,sh ⊢ Val v : T = (typeof⇘h⇙ v = Some T)"
apply(rule iffI)
apply (auto elim: WTrt.cases)
done
lemma [iff]: "P,E,h,sh ⊢ Var v : T = (E v = Some T)"
apply(rule iffI)
apply (auto elim: WTrt.cases)
done
lemma [iff]: "P,E,h,sh ⊢ e⇩1;;e⇩2 : T⇩2 = (∃T⇩1. P,E,h,sh ⊢ e⇩1:T⇩1 ∧ P,E,h,sh ⊢ e⇩2:T⇩2)"
apply(rule iffI)
apply (auto elim: WTrt.cases)
done
lemma [iff]: "P,E,h,sh ⊢ {V:T; e} : T' = (P,E(V↦T),h,sh ⊢ e : T')"
apply(rule iffI)
apply (auto elim: WTrt.cases)
done
inductive_cases WTrt_elim_cases[elim!]:
"P,E,h,sh ⊢ v :=e : T"
"P,E,h,sh ⊢ if (e) e⇩1 else e⇩2 : T"
"P,E,h,sh ⊢ while(e) c : T"
"P,E,h,sh ⊢ throw e : T"
"P,E,h,sh ⊢ try e⇩1 catch(C V) e⇩2 : T"
"P,E,h,sh ⊢ Cast D e : T"
"P,E,h,sh ⊢ e∙F{D} : T"
"P,E,h,sh ⊢ C∙⇩sF{D} : T"
"P,E,h,sh ⊢ e∙F{D} := v : T"
"P,E,h,sh ⊢ C∙⇩sF{D} := v : T"
"P,E,h,sh ⊢ e⇩1 «bop» e⇩2 : T"
"P,E,h,sh ⊢ new C : T"
"P,E,h,sh ⊢ e∙M{D}(es) : T"
"P,E,h,sh ⊢ C∙⇩sM{D}(es) : T"
"P,E,h,sh ⊢ INIT C (Cs,b) ← e : T"
"P,E,h,sh ⊢ RI(C,e);Cs ← e' : T"
subsection‹Some interesting lemmas›
lemma WTrts_Val[simp]:
"⋀Ts. (P,E,h,sh ⊢ map Val vs [:] Ts) = (map (typeof⇘h⇙) vs = map Some Ts)"
apply(induct vs)
apply simp
apply(case_tac Ts)
apply simp
apply simp
done
lemma WTrts_same_length: "⋀Ts. P,E,h,sh ⊢ es [:] Ts ⟹ length es = length Ts"
by(induct es type:list)auto
lemma WTrt_env_mono:
"P,E,h,sh ⊢ e : T ⟹ (⋀E'. E ⊆⇩m E' ⟹ P,E',h,sh ⊢ e : T)" and
"P,E,h,sh ⊢ es [:] Ts ⟹ (⋀E'. E ⊆⇩m E' ⟹ P,E',h,sh ⊢ es [:] Ts)"
proof(induct rule: WTrt_inducts)
case (WTrtVar E V T)
then show ?case by(simp add: WTrtVar map_le_def dom_def)
next
case (WTrtLAss E V T e T')
then show ?case by(force simp: map_le_def)
qed(fastforce intro: WTrt_WTrts.intros)+
lemma WTrt_hext_mono: "P,E,h,sh ⊢ e : T ⟹ h ⊴ h' ⟹ P,E,h',sh ⊢ e : T"
and WTrts_hext_mono: "P,E,h,sh ⊢ es [:] Ts ⟹ h ⊴ h' ⟹ P,E,h',sh ⊢ es [:] Ts"
apply(induct rule: WTrt_inducts)
apply(simp add: WTrtNew)
apply(fastforce simp: WTrtCast)
apply(fastforce simp: WTrtVal dest:hext_typeof_mono)
apply(simp add: WTrtVar)
apply(fastforce simp add: WTrtBinOpEq)
apply(fastforce simp add: WTrtBinOpAdd)
apply(fastforce simp add: WTrtLAss)
apply(fast intro: WTrtFAcc)
apply(simp add: WTrtFAccNT)
apply(fast intro: WTrtSFAcc)
apply(fastforce simp: WTrtFAss del:WTrt_WTrts.intros WTrt_elim_cases)
apply(fastforce simp: WTrtFAssNT)
apply(fastforce simp: WTrtSFAss del:WTrt_WTrts.intros WTrt_elim_cases)
apply(fastforce simp: WTrtCall)
apply(fastforce simp: WTrtCallNT)
using WTrtSCall apply blast
apply(fastforce)
apply(fastforce simp add: WTrtSeq)
apply(fastforce simp add: WTrtCond)
apply(fastforce simp add: WTrtWhile)
apply(fastforce simp add: WTrtThrow)
apply(fastforce simp: WTrtTry)
apply(simp add: WTrtInit)
apply(simp add: WTrtRI)
apply(simp add: WTrtNil)
apply(simp add: WTrtCons)
done
lemma WTrt_shext_mono: "P,E,h,sh ⊢ e : T ⟹ sh ⊴⇩s sh' ⟹ ¬sub_RI e ⟹ P,E,h,sh' ⊢ e : T"
and WTrts_shext_mono: "P,E,h,sh ⊢ es [:] Ts ⟹ sh ⊴⇩s sh' ⟹ ¬sub_RIs es ⟹ P,E,h,sh' ⊢ es [:] Ts"
by(induct rule: WTrt_inducts)
(auto simp add: WTrt_WTrts.intros)
lemma WTrt_hext_shext_mono: "P,E,h,sh ⊢ e : T
⟹ h ⊴ h' ⟹ sh ⊴⇩s sh' ⟹ ¬sub_RI e ⟹ P,E,h',sh' ⊢ e : T"
by(auto intro: WTrt_hext_mono WTrt_shext_mono)
lemma WTrts_hext_shext_mono: "P,E,h,sh ⊢ es [:] Ts
⟹ h ⊴ h' ⟹ sh ⊴⇩s sh' ⟹ ¬sub_RIs es ⟹ P,E,h',sh' ⊢ es [:] Ts"
by(auto intro: WTrts_hext_mono WTrts_shext_mono)
lemma WT_implies_WTrt: "P,E ⊢ e :: T ⟹ P,E,h,sh ⊢ e : T"
and WTs_implies_WTrts: "P,E ⊢ es [::] Ts ⟹ P,E,h,sh ⊢ es [:] Ts"
apply(induct rule: WT_WTs_inducts)
apply fast
apply (fast)
apply(fastforce dest:typeof_lit_typeof)
apply(simp)
apply(fastforce)
apply(fastforce)
apply(fastforce)
apply(meson WTrtFAcc has_visible_field)
apply(meson WTrtSFAcc has_visible_field)
apply(meson WTrtFAss has_visible_field)
apply(meson WTrtSFAss has_visible_field)
apply(fastforce simp: WTrtCall)
apply(fastforce simp: WTrtSCall)
apply(fastforce)
apply(fastforce)
apply(fastforce simp: WTrtCond)
apply(fastforce)
apply(fastforce)
apply(fastforce)
apply(simp)
apply(simp)
done
end
Theory State
section ‹ Program State ›
theory State imports "../Common/Exceptions" begin
type_synonym
locals = "vname ⇀ val"
type_synonym
state = "heap × locals × sheap"
definition hp :: "state ⇒ heap"
where
"hp ≡ fst"
definition lcl :: "state ⇒ locals"
where
"lcl ≡ fst ∘ snd"
definition shp :: "state ⇒ sheap"
where
"shp ≡ snd ∘ snd"
declare hp_def[simp] lcl_def[simp] shp_def[simp]
end
Theory SystemClasses
section ‹ System Classes ›
theory SystemClasses
imports Decl Exceptions
begin
text ‹
This theory provides definitions for the @{text Object} class,
and the system exceptions.
›
definition ObjectC :: "'m cdecl"
where
"ObjectC ≡ (Object, (undefined,[],[]))"
definition NullPointerC :: "'m cdecl"
where
"NullPointerC ≡ (NullPointer, (Object,[],[]))"
definition ClassCastC :: "'m cdecl"
where
"ClassCastC ≡ (ClassCast, (Object,[],[]))"
definition OutOfMemoryC :: "'m cdecl"
where
"OutOfMemoryC ≡ (OutOfMemory, (Object,[],[]))"
definition NoClassDefFoundC :: "'m cdecl"
where
"NoClassDefFoundC ≡ (NoClassDefFoundError, (Object,[],[]))"
definition IncompatibleClassChangeC :: "'m cdecl"
where
"IncompatibleClassChangeC ≡ (IncompatibleClassChangeError, (Object,[],[]))"
definition NoSuchFieldC :: "'m cdecl"
where
"NoSuchFieldC ≡ (NoSuchFieldError, (Object,[],[]))"
definition NoSuchMethodC :: "'m cdecl"
where
"NoSuchMethodC ≡ (NoSuchMethodError, (Object,[],[]))"
definition SystemClasses :: "'m cdecl list"
where
"SystemClasses ≡ [ObjectC, NullPointerC, ClassCastC, OutOfMemoryC, NoClassDefFoundC,
IncompatibleClassChangeC, NoSuchFieldC, NoSuchMethodC]"
end
Theory WellForm
section ‹ Generic Well-formedness of programs ›
theory WellForm imports TypeRel SystemClasses begin
text ‹\noindent This theory defines global well-formedness conditions
for programs but does not look inside method bodies. Hence it works
for both Jinja and JVM programs. Well-typing of expressions is defined
elsewhere (in theory @{text WellType}).
Because Jinja does not have method overloading, its policy for method
overriding is the classical one: \emph{covariant in the result type
but contravariant in the argument types.} This means the result type
of the overriding method becomes more specific, the argument types
become more general.
›
type_synonym 'm wf_mdecl_test = "'m prog ⇒ cname ⇒ 'm mdecl ⇒ bool"
definition wf_fdecl :: "'m prog ⇒ fdecl ⇒ bool"
where
"wf_fdecl P ≡ λ(F,b,T). is_type P T"
definition wf_mdecl :: "'m wf_mdecl_test ⇒ 'm wf_mdecl_test"
where
"wf_mdecl wf_md P C ≡ λ(M,b,Ts,T,m).
(∀T∈set Ts. is_type P T) ∧ is_type P T ∧ wf_md P C (M,b,Ts,T,m)"
definition wf_clinit :: "'m mdecl list ⇒ bool" where
"wf_clinit ms = (∃m. (clinit,Static,[],Void,m)∈set ms)"
definition wf_cdecl :: "'m wf_mdecl_test ⇒ 'm prog ⇒ 'm cdecl ⇒ bool"
where
"wf_cdecl wf_md P ≡ λ(C,(D,fs,ms)).
(∀f∈set fs. wf_fdecl P f) ∧ distinct_fst fs ∧
(∀m∈set ms. wf_mdecl wf_md P C m) ∧ distinct_fst ms ∧
(C ≠ Object ⟶
is_class P D ∧ ¬ P ⊢ D ≼⇧* C ∧
(∀(M,b,Ts,T,m)∈set ms.
∀D' b' Ts' T' m'. P ⊢ D sees M,b':Ts' → T' = m' in D' ⟶
b = b' ∧ P ⊢ Ts' [≤] Ts ∧ P ⊢ T ≤ T')) ∧
wf_clinit ms"
definition wf_syscls :: "'m prog ⇒ bool"
where
"wf_syscls P ≡ {Object} ∪ sys_xcpts ⊆ set(map fst P)"
definition wf_prog :: "'m wf_mdecl_test ⇒ 'm prog ⇒ bool"
where
"wf_prog wf_md P ≡ wf_syscls P ∧ (∀c ∈ set P. wf_cdecl wf_md P c) ∧ distinct_fst P"
subsection‹ Well-formedness lemmas ›
lemma class_wf:
"⟦class P C = Some c; wf_prog wf_md P⟧ ⟹ wf_cdecl wf_md P (C,c)"
by (unfold wf_prog_def class_def) (fast dest: map_of_SomeD)
lemma class_Object [simp]:
"wf_prog wf_md P ⟹ ∃C fs ms. class P Object = Some (C,fs,ms)"
by (unfold wf_prog_def wf_syscls_def class_def)
(auto simp: map_of_SomeI)
lemma is_class_Object [simp]:
"wf_prog wf_md P ⟹ is_class P Object"
by (simp add: is_class_def)
lemma is_class_supclass:
assumes wf: "wf_prog wf_md P" and sub: "P ⊢ C ≼⇧* D"
shows "is_class P C ⟹ is_class P D"
using sub proof(induct)
case step then show ?case
by(auto simp:wf_cdecl_def is_class_def dest!:class_wf[OF _ wf] subcls1D)
qed simp
lemma is_class_xcpt:
"⟦ C ∈ sys_xcpts; wf_prog wf_md P ⟧ ⟹ is_class P C"
by (fastforce intro!: map_of_SomeI
simp add: wf_prog_def wf_syscls_def is_class_def class_def)
lemma subcls1_wfD:
assumes sub1: "P ⊢ C ≺⇧1 D" and wf: "wf_prog wf_md P"
shows "D ≠ C ∧ (D,C) ∉ (subcls1 P)⇧+"
proof -
obtain fs ms where "C ≠ Object" and cls: "class P C = ⌊(D, fs, ms)⌋"
using subcls1D[OF sub1] by clarify
then show ?thesis using wf class_wf[OF cls wf] r_into_trancl[OF sub1]
by(force simp add: wf_cdecl_def reflcl_trancl [THEN sym]
simp del: reflcl_trancl)
qed
lemma wf_cdecl_supD:
"⟦wf_cdecl wf_md P (C,D,r); C ≠ Object⟧ ⟹ is_class P D"
by (auto simp: wf_cdecl_def)
lemma subcls_asym:
"⟦ wf_prog wf_md P; (C,D) ∈ (subcls1 P)⇧+ ⟧ ⟹ (D,C) ∉ (subcls1 P)⇧+"
by(erule tranclE; fast dest!: subcls1_wfD intro: trancl_trans)
lemma subcls_irrefl:
"⟦ wf_prog wf_md P; (C,D) ∈ (subcls1 P)⇧+ ⟧ ⟹ C ≠ D"
by (erule trancl_trans_induct) (auto dest: subcls1_wfD subcls_asym)
lemma acyclic_subcls1:
"wf_prog wf_md P ⟹ acyclic (subcls1 P)"
by (unfold acyclic_def) (fast dest: subcls_irrefl)
lemma wf_subcls1:
"wf_prog wf_md P ⟹ wf ((subcls1 P)¯)"
proof -
assume wf: "wf_prog wf_md P"
have "finite (subcls1 P)" by(rule finite_subcls1)
then have fin': "finite ((subcls1 P)¯)" by(subst finite_converse)
from wf have "acyclic (subcls1 P)" by(rule acyclic_subcls1)
then have acyc': "acyclic ((subcls1 P)¯)" by (subst acyclic_converse)
from fin' acyc' show ?thesis by (rule finite_acyclic_wf)
qed
lemma single_valued_subcls1:
"wf_prog wf_md G ⟹ single_valued (subcls1 G)"
by(auto simp:wf_prog_def distinct_fst_def single_valued_def dest!:subcls1D)
lemma subcls_induct:
"⟦ wf_prog wf_md P; ⋀C. ∀D. (C,D) ∈ (subcls1 P)⇧+ ⟶ Q D ⟹ Q C ⟧ ⟹ Q C"
(is "?A ⟹ PROP ?P ⟹ _")
proof -
assume p: "PROP ?P"
assume ?A then have wf: "wf_prog wf_md P" by assumption
have wf':"wf (((subcls1 P)⇧+)¯)" using wf_trancl[OF wf_subcls1[OF wf]]
by(simp only: trancl_converse)
show ?thesis using wf_induct[where a = C and P = Q, OF wf' p] by simp
qed
lemma subcls1_induct_aux:
assumes "is_class P C" and wf: "wf_prog wf_md P" and QObj: "Q Object"
shows
"⟦ ⋀C D fs ms.
⟦ C ≠ Object; is_class P C; class P C = Some (D,fs,ms) ∧
wf_cdecl wf_md P (C,D,fs,ms) ∧ P ⊢ C ≺⇧1 D ∧ is_class P D ∧ Q D⟧ ⟹ Q C ⟧
⟹ Q C"
(is "PROP ?P ⟹ _")
proof -
assume p: "PROP ?P"
have "class P C ≠ None ⟶ Q C"
proof(induct rule: subcls_induct[OF wf])
case (1 C)
have "class P C ≠ None ⟹ Q C"
proof(cases "C = Object")
case True
then show ?thesis using QObj by fast
next
case False
assume nNone: "class P C ≠ None"
then have is_cls: "is_class P C" by(simp add: is_class_def)
obtain D fs ms where cls: "class P C = ⌊(D, fs, ms)⌋" using nNone by safe
also have wfC: "wf_cdecl wf_md P (C, D, fs, ms)" by(rule class_wf[OF cls wf])
moreover have D: "is_class P D" by(rule wf_cdecl_supD[OF wfC False])
moreover have "P ⊢ C ≺⇧1 D" by(rule subcls1I[OF cls False])
moreover have "class P D ≠ None" using D by(simp add: is_class_def)
ultimately show ?thesis using 1 by (auto intro: p[OF False is_cls])
qed
then show "class P C ≠ None ⟶ Q C" by simp
qed
thus ?thesis using assms by(unfold is_class_def) simp
qed
lemma subcls1_induct [consumes 2, case_names Object Subcls]:
"⟦ wf_prog wf_md P; is_class P C; Q Object;
⋀C D. ⟦C ≠ Object; P ⊢ C ≺⇧1 D; is_class P D; Q D⟧ ⟹ Q C ⟧
⟹ Q C"
by (erule (2) subcls1_induct_aux) blast
lemma subcls_C_Object:
assumes "class": "is_class P C" and wf: "wf_prog wf_md P"
shows "P ⊢ C ≼⇧* Object"
using wf "class"
proof(induct rule: subcls1_induct)
case Subcls
then show ?case by(simp add: converse_rtrancl_into_rtrancl)
qed fast
lemma is_type_pTs:
assumes "wf_prog wf_md P" and "(C,S,fs,ms) ∈ set P" and "(M,b,Ts,T,m) ∈ set ms"
shows "set Ts ⊆ types P"
proof
from assms have "wf_mdecl wf_md P C (M,b,Ts,T,m)"
by (unfold wf_prog_def wf_cdecl_def) auto
hence "∀t ∈ set Ts. is_type P t" by (unfold wf_mdecl_def) auto
moreover fix t assume "t ∈ set Ts"
ultimately have "is_type P t" by blast
thus "t ∈ types P" ..
qed
lemma wf_supercls_distinct_app:
assumes wf:"wf_prog wf_md P"
and nObj: "C ≠ Object" and cls: "class P C = ⌊(D, fs, ms)⌋"
and super: "supercls_lst P (C#Cs)" and dist: "distinct (C#Cs)"
shows "distinct (D#C#Cs)"
proof -
have "¬ P ⊢ D ≼⇧* C" using subcls1_wfD[OF subcls1I[OF cls nObj] wf]
by (simp add: rtrancl_eq_or_trancl)
then show ?thesis using assms by auto
qed
subsection‹ Well-formedness and method lookup ›
lemma sees_wf_mdecl:
assumes wf: "wf_prog wf_md P" and sees: "P ⊢ C sees M,b:Ts→T = m in D"
shows "wf_mdecl wf_md P D (M,b,Ts,T,m)"
using wf visible_method_exists[OF sees] proof(cases b)
qed (fastforce simp:wf_cdecl_def dest!:class_wf dest:map_of_SomeD)+
lemma sees_method_mono [rule_format (no_asm)]:
assumes sub: "P ⊢ C' ≼⇧* C" and wf: "wf_prog wf_md P"
shows "∀D b Ts T m. P ⊢ C sees M,b:Ts→T = m in D ⟶
(∃D' Ts' T' m'. P ⊢ C' sees M,b:Ts'→T' = m' in D' ∧ P ⊢ Ts [≤] Ts' ∧ P ⊢ T' ≤ T)"
(is "∀D b Ts T m. ?P C D b Ts T m ⟶ ?Q C' D b Ts T m")
proof(rule disjE[OF rtranclD[OF sub]])
assume "C' = C"
then show ?thesis using assms by fastforce
next
assume "C' ≠ C ∧ (C', C) ∈ (subcls1 P)⇧+"
then have neq: "C' ≠ C" and subcls1: "(C', C) ∈ (subcls1 P)⇧+" by simp+
show ?thesis proof(induct rule: trancl_trans_induct[OF subcls1])
case (2 x y z)
then have zy: "⋀D b Ts T m. ?P z D b Ts T m ⟹ ?Q y D b Ts T m" by blast
have "⋀D b Ts T m. ?P z D b Ts T m ⟹ ?Q x D b Ts T m"
proof -
fix D b Ts T m assume P: "?P z D b Ts T m"
then show "?Q x D b Ts T m" using zy[OF P] 2(2)
by(fast elim: widen_trans widens_trans)
qed
then show ?case by blast
next
case (1 x y)
have "⋀D b Ts T m. ?P y D b Ts T m ⟹ ?Q x D b Ts T m"
proof -
fix D b Ts T m assume P: "?P y D b Ts T m"
then obtain Mm where sees: "P ⊢ y sees_methods Mm" and
M: "Mm M = ⌊((b, Ts, T, m), D)⌋"
by(clarsimp simp:Method_def)
obtain fs ms where nObj: "x ≠ Object" and
cls: "class P x = ⌊(y, fs, ms)⌋"
using subcls1D[OF 1] by clarsimp
have x_meth: "P ⊢ x sees_methods Mm ++ (map_option (λm. (m, x)) ∘ map_of ms)"
using sees_methods_rec[OF cls nObj sees] by simp
show "?Q x D b Ts T m" proof(cases "map_of ms M")
case None
then have "∃m'. P ⊢ x sees M, b : Ts→T = m' in D" using M x_meth
by(fastforce simp add:Method_def map_add_def split:option.split)
then show ?thesis by auto
next
case (Some a)
then obtain b' Ts' T' m' where a: "a = (b',Ts',T',m')" by(cases a)
then have "(∃m' Mm. P ⊢ y sees_methods Mm ∧ Mm M = ⌊((b, Ts, T, m'), D)⌋)
⟶ b' = b ∧ P ⊢ Ts [≤] Ts' ∧ P ⊢ T' ≤ T"
using nObj class_wf[OF cls wf] map_of_SomeD[OF Some]
by(clarsimp simp: wf_cdecl_def Method_def) fast
then show ?thesis using Some a sees M x_meth
by(fastforce simp:Method_def map_add_def split:option.split)
qed
qed
then show ?case by simp
qed
qed
lemma sees_method_mono2:
"⟦ P ⊢ C' ≼⇧* C; wf_prog wf_md P;
P ⊢ C sees M,b:Ts→T = m in D; P ⊢ C' sees M,b':Ts'→T' = m' in D' ⟧
⟹ b = b' ∧ P ⊢ Ts [≤] Ts' ∧ P ⊢ T' ≤ T"
by(blast dest:sees_method_mono sees_method_fun)
lemma mdecls_visible:
assumes wf: "wf_prog wf_md P" and "class": "is_class P C"
shows "⋀D fs ms. class P C = Some(D,fs,ms)
⟹ ∃Mm. P ⊢ C sees_methods Mm ∧ (∀(M,b,Ts,T,m) ∈ set ms. Mm M = Some((b,Ts,T,m),C))"
using wf "class"
proof (induct rule:subcls1_induct)
case Object
with wf have dfst:"distinct_fst ms"
by (unfold class_def wf_prog_def wf_cdecl_def) (fastforce dest:map_of_SomeD)
with dfst have "distinct_fst ms"
by(blast dest: distinct_fst_appendD)
with Object show ?case by(fastforce intro!: sees_methods_Object map_of_SomeI)
next
case Subcls
with wf have dfst:"distinct_fst ms"
by (unfold class_def wf_prog_def wf_cdecl_def) (fastforce dest:map_of_SomeD)
with dfst have "distinct_fst ms"
by(blast dest: distinct_fst_appendD)
with Subcls show ?case
by(fastforce elim:sees_methods_rec dest:subcls1D map_of_SomeI
simp:is_class_def)
qed
lemma mdecl_visible:
assumes wf: "wf_prog wf_md P" and C: "(C,S,fs,ms) ∈ set P" and m: "(M,b,Ts,T,m) ∈ set ms"
shows "P ⊢ C sees M,b:Ts→T = m in C"
proof -
from wf C have "class": "class P C = Some (S,fs,ms)"
by (auto simp add: wf_prog_def class_def is_class_def intro: map_of_SomeI)
from "class" have "is_class P C" by(auto simp:is_class_def)
with assms "class" show ?thesis
by(bestsimp simp:Method_def dest:mdecls_visible)
qed
lemma Call_lemma:
assumes sees: "P ⊢ C sees M,b:Ts→T = m in D" and sub: "P ⊢ C' ≼⇧* C" and wf: "wf_prog wf_md P"
shows "∃D' Ts' T' m'.
P ⊢ C' sees M,b:Ts'→T' = m' in D' ∧ P ⊢ Ts [≤] Ts' ∧ P ⊢ T' ≤ T ∧ P ⊢ C' ≼⇧* D'
∧ is_type P T' ∧ (∀T∈set Ts'. is_type P T) ∧ wf_md P D' (M,b,Ts',T',m')"
using assms sees_method_mono[OF sub wf sees]
by(fastforce intro:sees_method_decl_above dest:sees_wf_mdecl
simp: wf_mdecl_def)
lemma wf_prog_lift:
assumes wf: "wf_prog (λP C bd. A P C bd) P"
and rule:
"⋀wf_md C M b Ts C T m bd.
wf_prog wf_md P ⟹
P ⊢ C sees M,b:Ts→T = m in C ⟹
set Ts ⊆ types P ⟹
bd = (M,b,Ts,T,m) ⟹
A P C bd ⟹
B P C bd"
shows "wf_prog (λP C bd. B P C bd) P"
proof -
have "⋀c. c∈set P ⟹ wf_cdecl A P c ⟹ wf_cdecl B P c"
proof -
fix c assume "c∈set P" and "wf_cdecl A P c"
then show "wf_cdecl B P c"
using rule[OF wf mdecl_visible[OF wf] is_type_pTs[OF wf]]
by (auto simp: wf_cdecl_def wf_mdecl_def)
qed
then show ?thesis using wf by (clarsimp simp: wf_prog_def)
qed
lemma wf_sees_clinit:
assumes wf:"wf_prog wf_md P" and ex: "class P C = Some a"
shows "∃m. P ⊢ C sees clinit,Static:[] → Void = m in C"
proof -
from ex obtain D fs ms where "a = (D,fs,ms)" by(cases a)
then have sP: "(C, D, fs, ms) ∈ set P" using ex map_of_SomeD[of P C a] by(simp add: class_def)
then have "wf_clinit ms" using assms by(unfold wf_prog_def wf_cdecl_def, auto)
then obtain m where sm: "(clinit, Static, [], Void, m) ∈ set ms" by (meson wf_clinit_def)
then have "P ⊢ C sees clinit,Static:[] → Void = m in C"
using mdecl_visible[OF wf sP sm] by simp
then show ?thesis by(rule exI)
qed
lemma wf_sees_clinit1:
assumes wf:"wf_prog wf_md P" and ex: "class P C = Some a"
and "P ⊢ C sees clinit,b:Ts → T = m in D"
shows "b = Static ∧ Ts = [] ∧ T = Void ∧ D = C"
proof -
obtain m' where sees: "P ⊢ C sees clinit,Static:[] → Void = m' in C"
using wf_sees_clinit[OF wf ex] by clarify
then show ?thesis using sees wf by (meson assms(3) sees_method_fun)
qed
lemma wf_NonStatic_nclinit:
assumes wf: "wf_prog wf_md P" and meth: "P ⊢ C sees M,NonStatic:Ts→T=(mxs,mxl,ins,xt) in D"
shows "M ≠ clinit"
proof -
from sees_method_is_class[OF meth] obtain a where cls: "class P C = Some a"
by(clarsimp simp: is_class_def)
with wf wf_sees_clinit[OF wf cls]
obtain m where "P ⊢ C sees clinit,Static:[]→Void=m in C" by clarsimp
with meth show ?thesis by(auto dest: sees_method_fun)
qed
subsection‹ Well-formedness and field lookup ›
lemma wf_Fields_Ex:
assumes wf: "wf_prog wf_md P" and "is_class P C"
shows "∃FDTs. P ⊢ C has_fields FDTs"
using assms proof(induct rule:subcls1_induct)
case Object
then show ?case using class_Object[OF wf]
by(blast intro:has_fields_Object)
next
case Subcls
then show ?case by(blast intro:has_fields_rec dest:subcls1D)
qed
lemma has_fields_types:
"⟦ P ⊢ C has_fields FDTs; (FD,b,T) ∈ set FDTs; wf_prog wf_md P ⟧ ⟹ is_type P T"
proof(induct rule:Fields.induct)
qed(fastforce dest!: class_wf simp: wf_cdecl_def wf_fdecl_def)+
lemma sees_field_is_type:
"⟦ P ⊢ C sees F,b:T in D; wf_prog wf_md P ⟧ ⟹ is_type P T"
by (meson has_field_def has_fields_types has_visible_field map_of_SomeD)
lemma wf_syscls:
"set SystemClasses ⊆ set P ⟹ wf_syscls P"
by (force simp: image_def SystemClasses_def wf_syscls_def sys_xcpts_def
ObjectC_def NullPointerC_def ClassCastC_def OutOfMemoryC_def
NoClassDefFoundC_def
IncompatibleClassChangeC_def NoSuchFieldC_def NoSuchMethodC_def)
subsection‹ Well-formedness and subclassing ›
lemma wf_subcls_nCls:
assumes wf: "wf_prog wf_md P" and ns: "¬ is_class P C"
shows "⟦ P ⊢ D ≼⇧* D'; D ≠ C ⟧ ⟹ D' ≠ C"
proof(induct rule: rtrancl.induct)
case (rtrancl_into_rtrancl a b c)
with ns show ?case by(clarsimp dest!: subcls1D wf_cdecl_supD[OF class_wf[OF _ wf]])
qed(simp)
lemma wf_subcls_nCls':
assumes wf: "wf_prog wf_md P" and ns: "¬is_class P C⇩0"
shows "⋀cd D'. cd ∈ set P ⟹ ¬P ⊢ fst cd ≼⇧* C⇩0"
proof -
fix cd D' assume cd: "cd ∈ set P"
then have cls: "is_class P (fst cd)" using class_exists_equiv is_class_def by blast
with wf_subcls_nCls[OF wf ns] ns show "¬P ⊢ fst cd ≼⇧* C⇩0" by(cases "fst cd = D'", auto)
qed
lemma wf_nclass_nsub:
"⟦ wf_prog wf_md P; is_class P C; ¬is_class P C' ⟧ ⟹ ¬P ⊢ C ≼⇧* C'"
by(rule notI, auto dest: wf_subcls_nCls[where C=C' and D=C])
lemma wf_sys_xcpt_nsub_Start:
assumes wf: "wf_prog wf_md P" and ns: "¬is_class P Start" and sx: "C ∈ sys_xcpts"
shows "¬P ⊢ C ≼⇧* Start"
proof -
have Cns: "C ≠ Start" using Start_nsys_xcpts sx by clarsimp
show ?thesis using wf_subcls_nCls[OF wf ns _ Cns] by auto
qed
end
Theory BigStep
section ‹ Big Step Semantics ›
theory BigStep imports Expr State WWellForm begin
inductive
eval :: "J_prog ⇒ expr ⇒ state ⇒ expr ⇒ state ⇒ bool"
("_ ⊢ ((1⟨_,/_⟩) ⇒/ (1⟨_,/_⟩))" [51,0,0,0,0] 81)
and evals :: "J_prog ⇒ expr list ⇒ state ⇒ expr list ⇒ state ⇒ bool"
("_ ⊢ ((1⟨_,/_⟩) [⇒]/ (1⟨_,/_⟩))" [51,0,0,0,0] 81)
for P :: J_prog
where
New:
"⟦ sh C = Some (sfs, Done); new_Addr h = Some a;
P ⊢ C has_fields FDTs; h' = h(a↦blank P C) ⟧
⟹ P ⊢ ⟨new C,(h,l,sh)⟩ ⇒ ⟨addr a,(h',l,sh)⟩"
| NewFail:
"⟦ sh C = Some (sfs, Done); new_Addr h = None; is_class P C ⟧ ⟹
P ⊢ ⟨new C, (h,l,sh)⟩ ⇒ ⟨THROW OutOfMemory,(h,l,sh)⟩"
| NewInit:
"⟦ ∄sfs. sh C = Some (sfs, Done); P ⊢ ⟨INIT C ([C],False) ← unit,(h,l,sh)⟩ ⇒ ⟨Val v',(h',l',sh')⟩;
new_Addr h' = Some a; P ⊢ C has_fields FDTs; h'' = h'(a↦blank P C) ⟧
⟹ P ⊢ ⟨new C,(h,l,sh)⟩ ⇒ ⟨addr a,(h'',l',sh')⟩"
| NewInitOOM:
"⟦ ∄sfs. sh C = Some (sfs, Done); P ⊢ ⟨INIT C ([C],False) ← unit,(h,l,sh)⟩ ⇒ ⟨Val v',(h',l',sh')⟩;
new_Addr h' = None; is_class P C ⟧
⟹ P ⊢ ⟨new C,(h,l,sh)⟩ ⇒ ⟨THROW OutOfMemory,(h',l',sh')⟩"
| NewInitThrow:
"⟦ ∄sfs. sh C = Some (sfs, Done); P ⊢ ⟨INIT C ([C],False) ← unit,(h,l,sh)⟩ ⇒ ⟨throw a,s'⟩;
is_class P C ⟧
⟹ P ⊢ ⟨new C,(h,l,sh)⟩ ⇒ ⟨throw a,s'⟩"
| Cast:
"⟦ P ⊢ ⟨e,s⇩0⟩ ⇒ ⟨addr a,(h,l,sh)⟩; h a = Some(D,fs); P ⊢ D ≼⇧* C ⟧
⟹ P ⊢ ⟨Cast C e,s⇩0⟩ ⇒ ⟨addr a,(h,l,sh)⟩"
| CastNull:
"P ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⇩1⟩ ⟹
P ⊢ ⟨Cast C e,s⇩0⟩ ⇒ ⟨null,s⇩1⟩"
| CastFail:
"⟦ P ⊢ ⟨e,s⇩0⟩⇒ ⟨addr a,(h,l,sh)⟩; h a = Some(D,fs); ¬ P ⊢ D ≼⇧* C ⟧
⟹ P ⊢ ⟨Cast C e,s⇩0⟩ ⇒ ⟨THROW ClassCast,(h,l,sh)⟩"
| CastThrow:
"P ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩ ⟹
P ⊢ ⟨Cast C e,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩"
| Val:
"P ⊢ ⟨Val v,s⟩ ⇒ ⟨Val v,s⟩"
| BinOp:
"⟦ P ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨Val v⇩1,s⇩1⟩; P ⊢ ⟨e⇩2,s⇩1⟩ ⇒ ⟨Val v⇩2,s⇩2⟩; binop(bop,v⇩1,v⇩2) = Some v ⟧
⟹ P ⊢ ⟨e⇩1 «bop» e⇩2,s⇩0⟩ ⇒ ⟨Val v,s⇩2⟩"
| BinOpThrow1:
"P ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨throw e,s⇩1⟩ ⟹
P ⊢ ⟨e⇩1 «bop» e⇩2, s⇩0⟩ ⇒ ⟨throw e,s⇩1⟩"
| BinOpThrow2:
"⟦ P ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨Val v⇩1,s⇩1⟩; P ⊢ ⟨e⇩2,s⇩1⟩ ⇒ ⟨throw e,s⇩2⟩ ⟧
⟹ P ⊢ ⟨e⇩1 «bop» e⇩2,s⇩0⟩ ⇒ ⟨throw e,s⇩2⟩"
| Var:
"l V = Some v ⟹
P ⊢ ⟨Var V,(h,l,sh)⟩ ⇒ ⟨Val v,(h,l,sh)⟩"
| LAss:
"⟦ P ⊢ ⟨e,s⇩0⟩ ⇒ ⟨Val v,(h,l,sh)⟩; l' = l(V↦v) ⟧
⟹ P ⊢ ⟨V:=e,s⇩0⟩ ⇒ ⟨unit,(h,l',sh)⟩"
| LAssThrow:
"P ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩ ⟹
P ⊢ ⟨V:=e,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩"
| FAcc:
"⟦ P ⊢ ⟨e,s⇩0⟩ ⇒ ⟨addr a,(h,l,sh)⟩; h a = Some(C,fs);
P ⊢ C has F,NonStatic:t in D;
fs(F,D) = Some v ⟧
⟹ P ⊢ ⟨e∙F{D},s⇩0⟩ ⇒ ⟨Val v,(h,l,sh)⟩"
| FAccNull:
"P ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⇩1⟩ ⟹
P ⊢ ⟨e∙F{D},s⇩0⟩ ⇒ ⟨THROW NullPointer,s⇩1⟩"
| FAccThrow:
"P ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩ ⟹
P ⊢ ⟨e∙F{D},s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩"
| FAccNone:
"⟦ P ⊢ ⟨e,s⇩0⟩ ⇒ ⟨addr a,(h,l,sh)⟩; h a = Some(C,fs);
¬(∃b t. P ⊢ C has F,b:t in D) ⟧
⟹ P ⊢ ⟨e∙F{D},s⇩0⟩ ⇒ ⟨THROW NoSuchFieldError,(h,l,sh)⟩"
| FAccStatic:
"⟦ P ⊢ ⟨e,s⇩0⟩ ⇒ ⟨addr a,(h,l,sh)⟩; h a = Some(C,fs);
P ⊢ C has F,Static:t in D ⟧
⟹ P ⊢ ⟨e∙F{D},s⇩0⟩ ⇒ ⟨THROW IncompatibleClassChangeError,(h,l,sh)⟩"
| SFAcc:
"⟦ P ⊢ C has F,Static:t in D;
sh D = Some (sfs,Done);
sfs F = Some v ⟧
⟹ P ⊢ ⟨C∙⇩sF{D},(h,l,sh)⟩ ⇒ ⟨Val v,(h,l,sh)⟩"
| SFAccInit:
"⟦ P ⊢ C has F,Static:t in D;
∄sfs. sh D = Some (sfs,Done); P ⊢ ⟨INIT D ([D],False) ← unit,(h,l,sh)⟩ ⇒ ⟨Val v',(h',l',sh')⟩;
sh' D = Some (sfs,i);
sfs F = Some v ⟧
⟹ P ⊢ ⟨C∙⇩sF{D},(h,l,sh)⟩ ⇒ ⟨Val v,(h',l',sh')⟩"
| SFAccInitThrow:
"⟦ P ⊢ C has F,Static:t in D;
∄sfs. sh D = Some (sfs,Done); P ⊢ ⟨INIT D ([D],False) ← unit,(h,l,sh)⟩ ⇒ ⟨throw a,s'⟩ ⟧
⟹ P ⊢ ⟨C∙⇩sF{D},(h,l,sh)⟩ ⇒ ⟨throw a,s'⟩"
| SFAccNone:
"⟦ ¬(∃b t. P ⊢ C has F,b:t in D) ⟧
⟹ P ⊢ ⟨C∙⇩sF{D},s⟩ ⇒ ⟨THROW NoSuchFieldError,s⟩"
| SFAccNonStatic:
"⟦ P ⊢ C has F,NonStatic:t in D ⟧
⟹ P ⊢ ⟨C∙⇩sF{D},s⟩ ⇒ ⟨THROW IncompatibleClassChangeError,s⟩"
| FAss:
"⟦ P ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨addr a,s⇩1⟩; P ⊢ ⟨e⇩2,s⇩1⟩ ⇒ ⟨Val v,(h⇩2,l⇩2,sh⇩2)⟩;
h⇩2 a = Some(C,fs); P ⊢ C has F,NonStatic:t in D;
fs' = fs((F,D)↦v); h⇩2' = h⇩2(a↦(C,fs')) ⟧
⟹ P ⊢ ⟨e⇩1∙F{D}:=e⇩2,s⇩0⟩ ⇒ ⟨unit,(h⇩2',l⇩2,sh⇩2)⟩"
| FAssNull:
"⟦ P ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨null,s⇩1⟩; P ⊢ ⟨e⇩2,s⇩1⟩ ⇒ ⟨Val v,s⇩2⟩ ⟧ ⟹
P ⊢ ⟨e⇩1∙F{D}:=e⇩2,s⇩0⟩ ⇒ ⟨THROW NullPointer,s⇩2⟩"
| FAssThrow1:
"P ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩ ⟹
P ⊢ ⟨e⇩1∙F{D}:=e⇩2,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩"
| FAssThrow2:
"⟦ P ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨Val v,s⇩1⟩; P ⊢ ⟨e⇩2,s⇩1⟩ ⇒ ⟨throw e',s⇩2⟩ ⟧
⟹ P ⊢ ⟨e⇩1∙F{D}:=e⇩2,s⇩0⟩ ⇒ ⟨throw e',s⇩2⟩"
| FAssNone:
"⟦ P ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨addr a,s⇩1⟩; P ⊢ ⟨e⇩2,s⇩1⟩ ⇒ ⟨Val v,(h⇩2,l⇩2,sh⇩2)⟩;
h⇩2 a = Some(C,fs); ¬(∃b t. P ⊢ C has F,b:t in D) ⟧
⟹ P ⊢ ⟨e⇩1∙F{D}:=e⇩2,s⇩0⟩ ⇒ ⟨THROW NoSuchFieldError,(h⇩2,l⇩2,sh⇩2)⟩"
| FAssStatic:
"⟦ P ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨addr a,s⇩1⟩; P ⊢ ⟨e⇩2,s⇩1⟩ ⇒ ⟨Val v,(h⇩2,l⇩2,sh⇩2)⟩;
h⇩2 a = Some(C,fs); P ⊢ C has F,Static:t in D ⟧
⟹ P ⊢ ⟨e⇩1∙F{D}:=e⇩2,s⇩0⟩ ⇒ ⟨THROW IncompatibleClassChangeError,(h⇩2,l⇩2,sh⇩2)⟩"
| SFAss:
"⟦ P ⊢ ⟨e⇩2,s⇩0⟩ ⇒ ⟨Val v,(h⇩1,l⇩1,sh⇩1)⟩;
P ⊢ C has F,Static:t in D;
sh⇩1 D = Some(sfs,Done); sfs' = sfs(F↦v); sh⇩1' = sh⇩1(D↦(sfs',Done)) ⟧
⟹ P ⊢ ⟨C∙⇩sF{D}:=e⇩2,s⇩0⟩ ⇒ ⟨unit,(h⇩1,l⇩1,sh⇩1')⟩"
| SFAssInit:
"⟦ P ⊢ ⟨e⇩2,s⇩0⟩ ⇒ ⟨Val v,(h⇩1,l⇩1,sh⇩1)⟩;
P ⊢ C has F,Static:t in D;
∄sfs. sh⇩1 D = Some(sfs,Done); P ⊢ ⟨INIT D ([D],False) ← unit,(h⇩1,l⇩1,sh⇩1)⟩ ⇒ ⟨Val v',(h',l',sh')⟩;
sh' D = Some(sfs,i);
sfs' = sfs(F↦v); sh'' = sh'(D↦(sfs',i)) ⟧
⟹ P ⊢ ⟨C∙⇩sF{D}:=e⇩2,s⇩0⟩ ⇒ ⟨unit,(h',l',sh'')⟩"
| SFAssInitThrow:
"⟦ P ⊢ ⟨e⇩2,s⇩0⟩ ⇒ ⟨Val v,(h⇩1,l⇩1,sh⇩1)⟩;
P ⊢ C has F,Static:t in D;
∄sfs. sh⇩1 D = Some(sfs,Done); P ⊢ ⟨INIT D ([D],False) ← unit,(h⇩1,l⇩1,sh⇩1)⟩ ⇒ ⟨throw a,s'⟩ ⟧
⟹ P ⊢ ⟨C∙⇩sF{D}:=e⇩2,s⇩0⟩ ⇒ ⟨throw a,s'⟩"
| SFAssThrow:
"P ⊢ ⟨e⇩2,s⇩0⟩ ⇒ ⟨throw e',s⇩2⟩
⟹ P ⊢ ⟨C∙⇩sF{D}:=e⇩2,s⇩0⟩ ⇒ ⟨throw e',s⇩2⟩"
| SFAssNone:
"⟦ P ⊢ ⟨e⇩2,s⇩0⟩ ⇒ ⟨Val v,(h⇩2,l⇩2,sh⇩2)⟩;
¬(∃b t. P ⊢ C has F,b:t in D) ⟧
⟹ P ⊢ ⟨C∙⇩sF{D}:=e⇩2,s⇩0⟩ ⇒ ⟨THROW NoSuchFieldError,(h⇩2,l⇩2,sh⇩2)⟩"
| SFAssNonStatic:
"⟦ P ⊢ ⟨e⇩2,s⇩0⟩ ⇒ ⟨Val v,(h⇩2,l⇩2,sh⇩2)⟩;
P ⊢ C has F,NonStatic:t in D ⟧
⟹ P ⊢ ⟨C∙⇩sF{D}:=e⇩2,s⇩0⟩ ⇒ ⟨THROW IncompatibleClassChangeError,(h⇩2,l⇩2,sh⇩2)⟩"
| CallObjThrow:
"P ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩ ⟹
P ⊢ ⟨e∙M(ps),s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩"
| CallParamsThrow:
"⟦ P ⊢ ⟨e,s⇩0⟩ ⇒ ⟨Val v,s⇩1⟩; P ⊢ ⟨es,s⇩1⟩ [⇒] ⟨map Val vs @ throw ex # es',s⇩2⟩ ⟧
⟹ P ⊢ ⟨e∙M(es),s⇩0⟩ ⇒ ⟨throw ex,s⇩2⟩"
| CallNull:
"⟦ P ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⇩1⟩; P ⊢ ⟨ps,s⇩1⟩ [⇒] ⟨map Val vs,s⇩2⟩ ⟧
⟹ P ⊢ ⟨e∙M(ps),s⇩0⟩ ⇒ ⟨THROW NullPointer,s⇩2⟩"
| CallNone:
"⟦ P ⊢ ⟨e,s⇩0⟩ ⇒ ⟨addr a,s⇩1⟩; P ⊢ ⟨ps,s⇩1⟩ [⇒] ⟨map Val vs,(h⇩2,l⇩2,sh⇩2)⟩;
h⇩2 a = Some(C,fs); ¬(∃b Ts T m D. P ⊢ C sees M,b:Ts→T = m in D) ⟧
⟹ P ⊢ ⟨e∙M(ps),s⇩0⟩ ⇒ ⟨THROW NoSuchMethodError,(h⇩2,l⇩2,sh⇩2)⟩"
| CallStatic:
"⟦ P ⊢ ⟨e,s⇩0⟩ ⇒ ⟨addr a,s⇩1⟩; P ⊢ ⟨ps,s⇩1⟩ [⇒] ⟨map Val vs,(h⇩2,l⇩2,sh⇩2)⟩;
h⇩2 a = Some(C,fs); P ⊢ C sees M,Static:Ts→T = m in D ⟧
⟹ P ⊢ ⟨e∙M(ps),s⇩0⟩ ⇒ ⟨THROW IncompatibleClassChangeError,(h⇩2,l⇩2,sh⇩2)⟩"
| Call:
"⟦ P ⊢ ⟨e,s⇩0⟩ ⇒ ⟨addr a,s⇩1⟩; P ⊢ ⟨ps,s⇩1⟩ [⇒] ⟨map Val vs,(h⇩2,l⇩2,sh⇩2)⟩;
h⇩2 a = Some(C,fs); P ⊢ C sees M,NonStatic:Ts→T = (pns,body) in D;
length vs = length pns; l⇩2' = [this↦Addr a, pns[↦]vs];
P ⊢ ⟨body,(h⇩2,l⇩2',sh⇩2)⟩ ⇒ ⟨e',(h⇩3,l⇩3,sh⇩3)⟩ ⟧
⟹ P ⊢ ⟨e∙M(ps),s⇩0⟩ ⇒ ⟨e',(h⇩3,l⇩2,sh⇩3)⟩"
| SCallParamsThrow:
"⟦ P ⊢ ⟨es,s⇩0⟩ [⇒] ⟨map Val vs @ throw ex # es',s⇩2⟩ ⟧
⟹ P ⊢ ⟨C∙⇩sM(es),s⇩0⟩ ⇒ ⟨throw ex,s⇩2⟩"
| SCallNone:
"⟦ P ⊢ ⟨ps,s⇩0⟩ [⇒] ⟨map Val vs,s⇩2⟩;
¬(∃b Ts T m D. P ⊢ C sees M,b:Ts→T = m in D) ⟧
⟹ P ⊢ ⟨C∙⇩sM(ps),s⇩0⟩ ⇒ ⟨THROW NoSuchMethodError,s⇩2⟩"
| SCallNonStatic:
"⟦ P ⊢ ⟨ps,s⇩0⟩ [⇒] ⟨map Val vs,s⇩2⟩;
P ⊢ C sees M,NonStatic:Ts→T = m in D ⟧
⟹ P ⊢ ⟨C∙⇩sM(ps),s⇩0⟩ ⇒ ⟨THROW IncompatibleClassChangeError,s⇩2⟩"
| SCallInitThrow:
"⟦ P ⊢ ⟨ps,s⇩0⟩ [⇒] ⟨map Val vs,(h⇩1,l⇩1,sh⇩1)⟩;
P ⊢ C sees M,Static:Ts→T = (pns,body) in D;
∄sfs. sh⇩1 D = Some(sfs,Done); M ≠ clinit;
P ⊢ ⟨INIT D ([D],False) ← unit,(h⇩1,l⇩1,sh⇩1)⟩ ⇒ ⟨throw a,s'⟩ ⟧
⟹ P ⊢ ⟨C∙⇩sM(ps),s⇩0⟩ ⇒ ⟨throw a,s'⟩"
| SCallInit:
"⟦ P ⊢ ⟨ps,s⇩0⟩ [⇒] ⟨map Val vs,(h⇩1,l⇩1,sh⇩1)⟩;
P ⊢ C sees M,Static:Ts→T = (pns,body) in D;
∄sfs. sh⇩1 D = Some(sfs,Done); M ≠ clinit;
P ⊢ ⟨INIT D ([D],False) ← unit,(h⇩1,l⇩1,sh⇩1)⟩ ⇒ ⟨Val v',(h⇩2,l⇩2,sh⇩2)⟩;
length vs = length pns; l⇩2' = [pns[↦]vs];
P ⊢ ⟨body,(h⇩2,l⇩2',sh⇩2)⟩ ⇒ ⟨e',(h⇩3,l⇩3,sh⇩3)⟩ ⟧
⟹ P ⊢ ⟨C∙⇩sM(ps),s⇩0⟩ ⇒ ⟨e',(h⇩3,l⇩2,sh⇩3)⟩"
| SCall:
"⟦ P ⊢ ⟨ps,s⇩0⟩ [⇒] ⟨map Val vs,(h⇩2,l⇩2,sh⇩2)⟩;
P ⊢ C sees M,Static:Ts→T = (pns,body) in D;
sh⇩2 D = Some(sfs,Done) ∨ (M = clinit ∧ sh⇩2 D = Some(sfs,Processing));
length vs = length pns; l⇩2' = [pns[↦]vs];
P ⊢ ⟨body,(h⇩2,l⇩2',sh⇩2)⟩ ⇒ ⟨e',(h⇩3,l⇩3,sh⇩3)⟩ ⟧
⟹ P ⊢ ⟨C∙⇩sM(ps),s⇩0⟩ ⇒ ⟨e',(h⇩3,l⇩2,sh⇩3)⟩"
| Block:
"P ⊢ ⟨e⇩0,(h⇩0,l⇩0(V:=None),sh⇩0)⟩ ⇒ ⟨e⇩1,(h⇩1,l⇩1,sh⇩1)⟩ ⟹
P ⊢ ⟨{V:T; e⇩0},(h⇩0,l⇩0,sh⇩0)⟩ ⇒ ⟨e⇩1,(h⇩1,l⇩1(V:=l⇩0 V),sh⇩1)⟩"
| Seq:
"⟦ P ⊢ ⟨e⇩0,s⇩0⟩ ⇒ ⟨Val v,s⇩1⟩; P ⊢ ⟨e⇩1,s⇩1⟩ ⇒ ⟨e⇩2,s⇩2⟩ ⟧
⟹ P ⊢ ⟨e⇩0;;e⇩1,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩"
| SeqThrow:
"P ⊢ ⟨e⇩0,s⇩0⟩ ⇒ ⟨throw e,s⇩1⟩ ⟹
P ⊢ ⟨e⇩0;;e⇩1,s⇩0⟩ ⇒ ⟨throw e,s⇩1⟩"
| CondT:
"⟦ P ⊢ ⟨e,s⇩0⟩ ⇒ ⟨true,s⇩1⟩; P ⊢ ⟨e⇩1,s⇩1⟩ ⇒ ⟨e',s⇩2⟩ ⟧
⟹ P ⊢ ⟨if (e) e⇩1 else e⇩2,s⇩0⟩ ⇒ ⟨e',s⇩2⟩"
| CondF:
"⟦ P ⊢ ⟨e,s⇩0⟩ ⇒ ⟨false,s⇩1⟩; P ⊢ ⟨e⇩2,s⇩1⟩ ⇒ ⟨e',s⇩2⟩ ⟧
⟹ P ⊢ ⟨if (e) e⇩1 else e⇩2,s⇩0⟩ ⇒ ⟨e',s⇩2⟩"
| CondThrow:
"P ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩ ⟹
P ⊢ ⟨if (e) e⇩1 else e⇩2, s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩"
| WhileF:
"P ⊢ ⟨e,s⇩0⟩ ⇒ ⟨false,s⇩1⟩ ⟹
P ⊢ ⟨while (e) c,s⇩0⟩ ⇒ ⟨unit,s⇩1⟩"
| WhileT:
"⟦ P ⊢ ⟨e,s⇩0⟩ ⇒ ⟨true,s⇩1⟩; P ⊢ ⟨c,s⇩1⟩ ⇒ ⟨Val v⇩1,s⇩2⟩; P ⊢ ⟨while (e) c,s⇩2⟩ ⇒ ⟨e⇩3,s⇩3⟩ ⟧
⟹ P ⊢ ⟨while (e) c,s⇩0⟩ ⇒ ⟨e⇩3,s⇩3⟩"
| WhileCondThrow:
"P ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩ ⟹
P ⊢ ⟨while (e) c,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩"
| WhileBodyThrow:
"⟦ P ⊢ ⟨e,s⇩0⟩ ⇒ ⟨true,s⇩1⟩; P ⊢ ⟨c,s⇩1⟩ ⇒ ⟨throw e',s⇩2⟩⟧
⟹ P ⊢ ⟨while (e) c,s⇩0⟩ ⇒ ⟨throw e',s⇩2⟩"
| Throw:
"P ⊢ ⟨e,s⇩0⟩ ⇒ ⟨addr a,s⇩1⟩ ⟹
P ⊢ ⟨throw e,s⇩0⟩ ⇒ ⟨Throw a,s⇩1⟩"
| ThrowNull:
"P ⊢ ⟨e,s⇩0⟩ ⇒ ⟨null,s⇩1⟩ ⟹
P ⊢ ⟨throw e,s⇩0⟩ ⇒ ⟨THROW NullPointer,s⇩1⟩"
| ThrowThrow:
"P ⊢ ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩ ⟹
P ⊢ ⟨throw e,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩"
| Try:
"P ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨Val v⇩1,s⇩1⟩ ⟹
P ⊢ ⟨try e⇩1 catch(C V) e⇩2,s⇩0⟩ ⇒ ⟨Val v⇩1,s⇩1⟩"
| TryCatch:
"⟦ P ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨Throw a,(h⇩1,l⇩1,sh⇩1)⟩; h⇩1 a = Some(D,fs); P ⊢ D ≼⇧* C;
P ⊢ ⟨e⇩2,(h⇩1,l⇩1(V↦Addr a),sh⇩1)⟩ ⇒ ⟨e⇩2',(h⇩2,l⇩2,sh⇩2)⟩ ⟧
⟹ P ⊢ ⟨try e⇩1 catch(C V) e⇩2,s⇩0⟩ ⇒ ⟨e⇩2',(h⇩2,l⇩2(V:=l⇩1 V),sh⇩2)⟩"
| TryThrow:
"⟦ P ⊢ ⟨e⇩1,s⇩0⟩ ⇒ ⟨Throw a,(h⇩1,l⇩1,sh⇩1)⟩; h⇩1 a = Some(D,fs); ¬ P ⊢ D ≼⇧* C ⟧
⟹ P ⊢ ⟨try e⇩1 catch(C V) e⇩2,s⇩0⟩ ⇒ ⟨Throw a,(h⇩1,l⇩1,sh⇩1)⟩"
| Nil:
"P ⊢ ⟨[],s⟩ [⇒] ⟨[],s⟩"
| Cons:
"⟦ P ⊢ ⟨e,s⇩0⟩ ⇒ ⟨Val v,s⇩1⟩; P ⊢ ⟨es,s⇩1⟩ [⇒] ⟨es',s⇩2⟩ ⟧
⟹ P ⊢ ⟨e#es,s⇩0⟩ [⇒] ⟨Val v # es',s⇩2⟩"
| ConsThrow:
"P ⊢ ⟨e, s⇩0⟩ ⇒ ⟨throw e', s⇩1⟩ ⟹
P ⊢ ⟨e#es, s⇩0⟩ [⇒] ⟨throw e' # es, s⇩1⟩"
| InitFinal:
"P ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩ ⟹ P ⊢ ⟨INIT C (Nil,b) ← e,s⟩ ⇒ ⟨e',s'⟩"
| InitNone:
"⟦ sh C = None; P ⊢ ⟨INIT C' (C#Cs,False) ← e,(h,l,sh(C ↦ (sblank P C, Prepared)))⟩ ⇒ ⟨e',s'⟩ ⟧
⟹ P ⊢ ⟨INIT C' (C#Cs,False) ← e,(h,l,sh)⟩ ⇒ ⟨e',s'⟩"
| InitDone:
"⟦ sh C = Some(sfs,Done); P ⊢ ⟨INIT C' (Cs,True) ← e,(h,l,sh)⟩ ⇒ ⟨e',s'⟩ ⟧
⟹ P ⊢ ⟨INIT C' (C#Cs,False) ← e,(h,l,sh)⟩ ⇒ ⟨e',s'⟩"
| InitProcessing:
"⟦ sh C = Some(sfs,Processing); P ⊢ ⟨INIT C' (Cs,True) ← e,(h,l,sh)⟩ ⇒ ⟨e',s'⟩ ⟧
⟹ P ⊢ ⟨INIT C' (C#Cs,False) ← e,(h,l,sh)⟩ ⇒ ⟨e',s'⟩"
| InitError:
"⟦ sh C = Some(sfs,Error);
P ⊢ ⟨RI (C, THROW NoClassDefFoundError);Cs ← e,(h,l,sh)⟩ ⇒ ⟨e',s'⟩ ⟧
⟹ P ⊢ ⟨INIT C' (C#Cs,False) ← e,(h,l,sh)⟩ ⇒ ⟨e',s'⟩"
| InitObject:
"⟦ sh C = Some(sfs,Prepared);
C = Object;
sh' = sh(C ↦ (sfs,Processing));
P ⊢ ⟨INIT C' (C#Cs,True) ← e,(h,l,sh')⟩ ⇒ ⟨e',s'⟩ ⟧
⟹ P ⊢ ⟨INIT C' (C#Cs,False) ← e,(h,l,sh)⟩ ⇒ ⟨e',s'⟩"
| InitNonObject:
"⟦ sh C = Some(sfs,Prepared);
C ≠ Object;
class P C = Some (D,r);
sh' = sh(C ↦ (sfs,Processing));
P ⊢ ⟨INIT C' (D#C#Cs,False) ← e,(h,l,sh')⟩ ⇒ ⟨e',s'⟩ ⟧
⟹ P ⊢ ⟨INIT C' (C#Cs,False) ← e,(h,l,sh)⟩ ⇒ ⟨e',s'⟩"
| InitRInit:
"P ⊢ ⟨RI (C,C∙⇩sclinit([]));Cs ← e,(h,l,sh)⟩ ⇒ ⟨e',s'⟩
⟹ P ⊢ ⟨INIT C' (C#Cs,True) ← e,(h,l,sh)⟩ ⇒ ⟨e',s'⟩"
| RInit:
"⟦ P ⊢ ⟨e',s⟩ ⇒ ⟨Val v, (h',l',sh')⟩;
sh' C = Some(sfs, i); sh'' = sh'(C ↦ (sfs, Done));
C' = last(C#Cs);
P ⊢ ⟨INIT C' (Cs,True) ← e, (h',l',sh'')⟩ ⇒ ⟨e⇩1,s⇩1⟩ ⟧
⟹ P ⊢ ⟨RI (C,e');Cs ← e,s⟩ ⇒ ⟨e⇩1,s⇩1⟩"
| RInitInitFail:
"⟦ P ⊢ ⟨e',s⟩ ⇒ ⟨throw a, (h',l',sh')⟩;
sh' C = Some(sfs, i); sh'' = sh'(C ↦ (sfs, Error));
P ⊢ ⟨RI (D,throw a);Cs ← e, (h',l',sh'')⟩ ⇒ ⟨e⇩1,s⇩1⟩ ⟧
⟹ P ⊢ ⟨RI (C,e');D#Cs ← e,s⟩ ⇒ ⟨e⇩1,s⇩1⟩"
| RInitFailFinal:
"⟦ P ⊢ ⟨e',s⟩ ⇒ ⟨throw a, (h',l',sh')⟩;
sh' C = Some(sfs, i); sh'' = sh'(C ↦ (sfs, Error)) ⟧
⟹ P ⊢ ⟨RI (C,e');Nil ← e,s⟩ ⇒ ⟨throw a, (h',l',sh'')⟩"
lemmas eval_evals_induct = eval_evals.induct [split_format (complete)]
and eval_evals_inducts = eval_evals.inducts [split_format (complete)]
inductive_cases eval_cases [cases set]:
"P ⊢ ⟨new C,s⟩ ⇒ ⟨e',s'⟩"
"P ⊢ ⟨Cast C e,s⟩ ⇒ ⟨e',s'⟩"
"P ⊢ ⟨Val v,s⟩ ⇒ ⟨e',s'⟩"
"P ⊢ ⟨e⇩1 «bop» e⇩2,s⟩ ⇒ ⟨e',s'⟩"
"P ⊢ ⟨Var v,s⟩ ⇒ ⟨e',s'⟩"
"P ⊢ ⟨V:=e,s⟩ ⇒ ⟨e',s'⟩"
"P ⊢ ⟨e∙F{D},s⟩ ⇒ ⟨e',s'⟩"
"P ⊢ ⟨C∙⇩sF{D},s⟩ ⇒ ⟨e',s'⟩"
"P ⊢ ⟨e⇩1∙F{D}:=e⇩2,s⟩ ⇒ ⟨e',s'⟩"
"P ⊢ ⟨C∙⇩sF{D}:=e⇩2,s⟩ ⇒ ⟨e',s'⟩"
"P ⊢ ⟨e∙M(es),s⟩ ⇒ ⟨e',s'⟩"
"P ⊢ ⟨C∙⇩sM(es),s⟩ ⇒ ⟨e',s'⟩"
"P ⊢ ⟨{V:T;e⇩1},s⟩ ⇒ ⟨e',s'⟩"
"P ⊢ ⟨e⇩1;;e⇩2,s⟩ ⇒ ⟨e',s'⟩"
"P ⊢ ⟨if (e) e⇩1 else e⇩2,s⟩ ⇒ ⟨e',s'⟩"
"P ⊢ ⟨while (b) c,s⟩ ⇒ ⟨e',s'⟩"
"P ⊢ ⟨throw e,s⟩ ⇒ ⟨e',s'⟩"
"P ⊢ ⟨try e⇩1 catch(C V) e⇩2,s⟩ ⇒ ⟨e',s'⟩"
"P ⊢ ⟨INIT C (Cs,b) ← e,s⟩ ⇒ ⟨e',s'⟩"
"P ⊢ ⟨RI (C,e);Cs ← e⇩0,s⟩ ⇒ ⟨e',s'⟩"
inductive_cases evals_cases [cases set]:
"P ⊢ ⟨[],s⟩ [⇒] ⟨e',s'⟩"
"P ⊢ ⟨e#es,s⟩ [⇒] ⟨e',s'⟩"
subsection "Final expressions"
lemma eval_final: "P ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩ ⟹ final e'"
and evals_final: "P ⊢ ⟨es,s⟩ [⇒] ⟨es',s'⟩ ⟹ finals es'"
by(induct rule:eval_evals.inducts, simp_all)
text‹ Only used later, in the small to big translation, but is already a
good sanity check: ›
lemma eval_finalId: "final e ⟹ P ⊢ ⟨e,s⟩ ⇒ ⟨e,s⟩"
by (erule finalE) (iprover intro: eval_evals.intros)+
lemma eval_final_same: "⟦ P ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩; final e ⟧ ⟹ e = e' ∧ s = s'"
by(auto elim!: finalE eval_cases)
lemma eval_finalsId:
assumes finals: "finals es" shows "P ⊢ ⟨es,s⟩ [⇒] ⟨es,s⟩"
using finals
proof (induct es type: list)
case Nil show ?case by (rule eval_evals.intros)
next
case (Cons e es)
have hyp: "finals es ⟹ P ⊢ ⟨es,s⟩ [⇒] ⟨es,s⟩"
and finals: "finals (e # es)" by fact+
show "P ⊢ ⟨e # es,s⟩ [⇒] ⟨e # es,s⟩"
proof cases
assume "final e"
thus ?thesis
proof (cases rule: finalE)
fix v assume e: "e = Val v"
have "P ⊢ ⟨Val v,s⟩ ⇒ ⟨Val v,s⟩" by (simp add: eval_finalId)
moreover from finals e have "P ⊢ ⟨es,s⟩ [⇒] ⟨es,s⟩" by(fast intro:hyp)
ultimately have "P ⊢ ⟨Val v#es,s⟩ [⇒] ⟨Val v#es,s⟩"
by (rule eval_evals.intros)
with e show ?thesis by simp
next
fix a assume e: "e = Throw a"
have "P ⊢ ⟨Throw a,s⟩ ⇒ ⟨Throw a,s⟩" by (simp add: eval_finalId)
hence "P ⊢ ⟨Throw a#es,s⟩ [⇒] ⟨Throw a#es,s⟩" by (rule eval_evals.intros)
with e show ?thesis by simp
qed
next
assume "¬ final e"
with not_finals_ConsI finals have False by blast
thus ?thesis ..
qed
qed
lemma evals_finals_same:
assumes finals: "finals es"
shows "P ⊢ ⟨es,s⟩ [⇒] ⟨es',s'⟩ ⟹ es = es' ∧ s = s'"
using finals
proof (induct es arbitrary: es' type: list)
case Nil then show ?case using evals_cases(1) by blast
next
case (Cons e es)
have IH: "⋀es'. P ⊢ ⟨es,s⟩ [⇒] ⟨es',s'⟩ ⟹ finals es ⟹ es = es' ∧ s = s'"
and step: "P ⊢ ⟨e # es,s⟩ [⇒] ⟨es',s'⟩" and finals: "finals (e # es)" by fact+
then obtain e' es'' where es': "es' = e'#es''" by (meson Cons.prems(1) evals_cases(2))
have fe: "final e" using finals not_finals_ConsI by auto
show ?case
proof(rule evals_cases(2)[OF step])
fix v s⇩1 es1 assume es1: "es' = Val v # es1"
and estep: "P ⊢ ⟨e,s⟩ ⇒ ⟨Val v,s⇩1⟩" and esstep: "P ⊢ ⟨es,s⇩1⟩ [⇒] ⟨es1,s'⟩"
then have "e = Val v" using eval_final_same fe by auto
then have "finals es" using es' not_finals_ConsI2 finals by blast
then show ?thesis using es' IH estep esstep es1 eval_final_same fe by blast
next
fix e' assume es1: "es' = throw e' # es" and estep: "P ⊢ ⟨e,s⟩ ⇒ ⟨throw e',s'⟩"
then have "e = throw e'" using eval_final_same fe by auto
then show ?thesis using es' estep es1 eval_final_same fe by blast
qed
qed
subsection "Property preservation"
lemma evals_length: "P ⊢ ⟨es,s⟩ [⇒] ⟨es',s'⟩ ⟹ length es = length es'"
by(induct es arbitrary:es' s s', auto elim: evals_cases)
corollary evals_empty: "P ⊢ ⟨es,s⟩ [⇒] ⟨es',s'⟩ ⟹ (es = []) = (es' = [])"
by(drule evals_length, fastforce)
theorem eval_hext: "P ⊢ ⟨e,(h,l,sh)⟩ ⇒ ⟨e',(h',l',sh')⟩ ⟹ h ⊴ h'"
and evals_hext: "P ⊢ ⟨es,(h,l,sh)⟩ [⇒] ⟨es',(h',l',sh')⟩ ⟹ h ⊴ h'"
proof (induct rule: eval_evals_inducts)
case New thus ?case
by(fastforce intro!: hext_new intro:LeastI simp:new_Addr_def
split:if_split_asm simp del:fun_upd_apply)
next
case NewInit thus ?case
by (meson hext_new hext_trans new_Addr_SomeD)
next
case FAss thus ?case
by(auto simp:sym[THEN hext_upd_obj] simp del:fun_upd_apply
elim!: hext_trans)
qed (auto elim!: hext_trans)
lemma eval_lcl_incr: "P ⊢ ⟨e,(h⇩0,l⇩0,sh⇩0)⟩ ⇒ ⟨e',(h⇩1,l⇩1,sh⇩1)⟩ ⟹ dom l⇩0 ⊆ dom l⇩1"
and evals_lcl_incr: "P ⊢ ⟨es,(h⇩0,l⇩0,sh⇩0)⟩ [⇒] ⟨es',(h⇩1,l⇩1,sh⇩1)⟩ ⟹ dom l⇩0 ⊆ dom l⇩1"
proof (induct rule: eval_evals_inducts)
case BinOp show ?case by(rule subset_trans)(rule BinOp.hyps)+
next
case Call thus ?case
by(simp del: fun_upd_apply)
next
case Seq show ?case by(rule subset_trans)(rule Seq.hyps)+
next
case CondT show ?case by(rule subset_trans)(rule CondT.hyps)+
next
case CondF show ?case by(rule subset_trans)(rule CondF.hyps)+
next
case WhileT thus ?case by(blast)
next
case TryCatch thus ?case by(clarsimp simp:dom_def split:if_split_asm) blast
next
case Cons show ?case by(rule subset_trans)(rule Cons.hyps)+
next
case Block thus ?case by(auto simp del:fun_upd_apply)
qed auto
lemma
shows init_ri_same_loc: "P ⊢ ⟨e,(h,l,sh)⟩ ⇒ ⟨e',(h',l',sh')⟩
⟹ (⋀C Cs b M a. e = INIT C (Cs,b) ← unit ∨ e = C∙⇩sM([]) ∨ e = RI (C,Throw a) ; Cs ← unit
∨ e = RI (C,C∙⇩sclinit([])) ; Cs ← unit
⟹ l = l')"
and "P ⊢ ⟨es,(h,l,sh)⟩ [⇒] ⟨es',(h',l',sh')⟩ ⟹ True"
proof(induct rule: eval_evals_inducts)
case (RInitInitFail e h l sh a')
then show ?case using eval_final[of _ _ _ "throw a'"]
by(fastforce dest: eval_final_same[of _ "Throw a"])
next
case RInitFailFinal then show ?case by(auto dest: eval_final_same)
qed(auto dest: evals_cases eval_cases(17) eval_final_same)
lemma init_same_loc: "P ⊢ ⟨INIT C (Cs,b) ← unit,(h,l,sh)⟩ ⇒ ⟨e',(h',l',sh')⟩ ⟹ l = l'"
by(simp add: init_ri_same_loc)
lemma assumes wf: "wwf_J_prog P"
shows eval_proc_pres': "P ⊢ ⟨e,(h,l,sh)⟩ ⇒ ⟨e',(h',l',sh')⟩
⟹ not_init C e ⟹ ∃sfs. sh C = ⌊(sfs, Processing)⌋ ⟹ ∃sfs'. sh' C = ⌊(sfs', Processing)⌋"
and evals_proc_pres': "P ⊢ ⟨es,(h,l,sh)⟩ [⇒] ⟨es',(h',l',sh')⟩
⟹ not_inits C es ⟹ ∃sfs. sh C = ⌊(sfs, Processing)⌋ ⟹ ∃sfs'. sh' C = ⌊(sfs', Processing)⌋"
proof(induct rule:eval_evals_inducts)
case Call then show ?case using sees_wwf_nsub_RI[OF wf Call.hyps(6)] nsub_RI_not_init by auto
next
case (SCallInit ps h l sh vs h⇩1 l⇩1 sh⇩1 C' M Ts T pns body D v' h⇩2 l⇩2 sh⇩2 l⇩2' e' h⇩3 l⇩3 sh⇩3)
then show ?case
using SCallInit sees_wwf_nsub_RI[OF wf SCallInit.hyps(3)] nsub_RI_not_init[of body] by auto
next
case SCall then show ?case using sees_wwf_nsub_RI[OF wf SCall.hyps(3)] nsub_RI_not_init by auto
next
case (InitNone sh C1 C' Cs h l e' a a b) then show ?case by(cases "C = C1") auto
next
case (InitDone sh C sfs C' Cs h l e' a a b) then show ?case by(cases Cs, auto)
next
case (InitProcessing sh C sfs C' Cs h l e' a a b) then show ?case by(cases Cs, auto)
next
case (InitError sh C1 sfs Cs h l e' a a b C') then show ?case by(cases "C = C1") auto
next
case (InitObject sh C1 sfs sh' C' Cs h l e' a a b) then show ?case by(cases "C = C1") auto
next
case (InitNonObject sh C1 sfs D a b sh' C' Cs h l e' a a b)
then show ?case by(cases "C = C1") auto
next
case (RInit e a a b v h' l' sh' C sfs i sh'' C' Cs e⇩1 a a b) then show ?case by(cases Cs, auto)
next
case (RInitInitFail e h l sh a h' l' sh' C1 sfs i sh'' D Cs e⇩1 h1 l1 sh1)
then show ?case using eval_final by fastforce
qed(auto)
subsection‹Init Elimination rules›
lemma init_NilE:
assumes init: "P ⊢ ⟨INIT C (Nil,b) ← unit,s⟩ ⇒ ⟨e',s'⟩"
shows "e' = unit ∧ s' = s"
proof(rule eval_cases(19)[OF init]) qed(auto dest: eval_final_same)
lemma init_ProcessingE:
assumes shC: "sh C = ⌊(sfs, Processing)⌋"
and init: "P ⊢ ⟨INIT C ([C],False) ← unit,(h,l,sh)⟩ ⇒ ⟨e',s'⟩"
shows "e' = unit ∧ s' = (h,l,sh)"
proof(rule eval_cases(19)[OF init])
fix sha Ca sfs Cs ha la
assume "(h, l, sh) = (ha, la, sha)" and "sha Ca = ⌊(sfs, Processing)⌋"
and "P ⊢ ⟨INIT C (Cs,True) ← unit,(ha, la, sha)⟩ ⇒ ⟨e',s'⟩" and "[C] = Ca # Cs"
then show ?thesis using init_NilE by simp
next
fix sha sfs Cs ha la
assume "(h, l, sh) = (ha, la, sha)" and "sha Object = ⌊(sfs, Prepared)⌋"
and "[C] = Object # Cs"
then show ?thesis using shC by clarsimp
qed(auto simp: assms)
lemma rinit_throwE:
"P ⊢ ⟨RI (C,throw e) ; Cs ← e⇩0,s⟩ ⇒ ⟨e',s'⟩
⟹ ∃a s⇩t. e' = throw a ∧ P ⊢ ⟨throw e,s⟩ ⇒ ⟨throw a,s⇩t⟩"
proof(induct Cs arbitrary: C e s)
case Nil
then show ?case
proof(rule eval_cases(20))
fix v h' l' sh' assume "P ⊢ ⟨throw e,s⟩ ⇒ ⟨Val v,(h', l', sh')⟩"
then show ?case using eval_cases(17) by blast
qed(auto)
next
case (Cons C' Cs')
show ?case using Cons.prems(1)
proof(rule eval_cases(20))
fix v h' l' sh' assume "P ⊢ ⟨throw e,s⟩ ⇒ ⟨Val v,(h', l', sh')⟩"
then show ?case using eval_cases(17) by blast
next
fix a h' l' sh' sfs i D Cs''
assume e''step: "P ⊢ ⟨throw e,s⟩ ⇒ ⟨throw a,(h', l', sh')⟩"
and shC: "sh' C = ⌊(sfs, i)⌋"
and riD: "P ⊢ ⟨RI (D,throw a) ; Cs'' ← e⇩0,(h', l', sh'(C ↦ (sfs, Error)))⟩ ⇒ ⟨e',s'⟩"
and "C' # Cs' = D # Cs''"
then show ?thesis using Cons.hyps eval_final eval_final_same by blast
qed(simp)
qed
lemma rinit_ValE:
assumes ri: "P ⊢ ⟨RI (C,e) ; Cs ← unit,s⟩ ⇒ ⟨Val v',s'⟩"
shows "∃v'' s''. P ⊢ ⟨e,s⟩ ⇒ ⟨Val v'',s''⟩"
proof(rule eval_cases(20)[OF ri])
fix a h' l' sh' sfs i D Cs'
assume "P ⊢ ⟨RI (D,throw a) ; Cs' ← unit,(h', l', sh'(C ↦ (sfs, Error)))⟩ ⇒ ⟨Val v',s'⟩"
then show ?thesis using rinit_throwE by blast
qed(auto)
subsection "Some specific evaluations"
lemma lass_val_of_eval:
"⟦ lass_val_of e = ⌊a⌋; P ⊢ ⟨e,(h, l, sh)⟩ ⇒ ⟨e',(h', l', sh')⟩ ⟧
⟹ e' = unit ∧ h' = h ∧ l' = l(fst a↦snd a) ∧ sh' = sh"
by(drule lass_val_of_spec, auto elim: eval.cases)
lemma eval_throw_nonVal:
assumes eval: "P ⊢ ⟨e,s⟩ ⇒ ⟨throw a,s'⟩"
shows "val_of e = None"
proof(cases "val_of e")
case (Some v) show ?thesis using eval by(auto simp: val_of_spec[OF Some] intro: eval.cases)
qed(simp)
lemma eval_throw_nonLAss:
assumes eval: "P ⊢ ⟨e,s⟩ ⇒ ⟨throw a,s'⟩"
shows "lass_val_of e = None"
proof(cases "lass_val_of e")
case (Some v) show ?thesis using eval by(auto simp: lass_val_of_spec[OF Some] intro: eval.cases)
qed(simp)
end
Theory DefAss
section ‹ Definite assignment ›
theory DefAss imports BigStep begin
subsection "Hypersets"
type_synonym 'a hyperset = "'a set option"
definition hyperUn :: "'a hyperset ⇒ 'a hyperset ⇒ 'a hyperset" (infixl "⊔" 65)
where
"A ⊔ B ≡ case A of None ⇒ None
| ⌊A⌋ ⇒ (case B of None ⇒ None | ⌊B⌋ ⇒ ⌊A ∪ B⌋)"
definition hyperInt :: "'a hyperset ⇒ 'a hyperset ⇒ 'a hyperset" (infixl "⊓" 70)
where
"A ⊓ B ≡ case A of None ⇒ B
| ⌊A⌋ ⇒ (case B of None ⇒ ⌊A⌋ | ⌊B⌋ ⇒ ⌊A ∩ B⌋)"
definition hyperDiff1 :: "'a hyperset ⇒ 'a ⇒ 'a hyperset" (infixl "⊖" 65)
where
"A ⊖ a ≡ case A of None ⇒ None | ⌊A⌋ ⇒ ⌊A - {a}⌋"
definition hyper_isin :: "'a ⇒ 'a hyperset ⇒ bool" (infix "∈∈" 50)
where
"a ∈∈ A ≡ case A of None ⇒ True | ⌊A⌋ ⇒ a ∈ A"
definition hyper_subset :: "'a hyperset ⇒ 'a hyperset ⇒ bool" (infix "⊑" 50)
where
"A ⊑ B ≡ case B of None ⇒ True
| ⌊B⌋ ⇒ (case A of None ⇒ False | ⌊A⌋ ⇒ A ⊆ B)"
lemmas hyperset_defs =
hyperUn_def hyperInt_def hyperDiff1_def hyper_isin_def hyper_subset_def
lemma [simp]: "⌊{}⌋ ⊔ A = A ∧ A ⊔ ⌊{}⌋ = A"
by(simp add:hyperset_defs)
lemma [simp]: "⌊A⌋ ⊔ ⌊B⌋ = ⌊A ∪ B⌋ ∧ ⌊A⌋ ⊖ a = ⌊A - {a}⌋"
by(simp add:hyperset_defs)
lemma [simp]: "None ⊔ A = None ∧ A ⊔ None = None"
by(simp add:hyperset_defs)
lemma [simp]: "a ∈∈ None ∧ None ⊖ a = None"
by(simp add:hyperset_defs)
lemma hyper_isin_union: "x ∈∈ ⌊A⌋ ⟹ x ∈∈ ⌊A⌋ ⊔ B"
by(case_tac B, auto simp: hyper_isin_def)
lemma hyperUn_assoc: "(A ⊔ B) ⊔ C = A ⊔ (B ⊔ C)"
by(simp add:hyperset_defs Un_assoc)
lemma hyper_insert_comm: "A ⊔ ⌊{a}⌋ = ⌊{a}⌋ ⊔ A ∧ A ⊔ (⌊{a}⌋ ⊔ B) = ⌊{a}⌋ ⊔ (A ⊔ B)"
by(simp add:hyperset_defs)
lemma hyper_comm: "A ⊔ B = B ⊔ A ∧ A ⊔ B ⊔ C = B ⊔ A ⊔ C"
apply(case_tac A, simp, case_tac B, simp)
apply(case_tac C, simp add: Un_commute)
apply(simp add: Un_left_commute Un_commute)
done
subsection "Definite assignment"
primrec
𝒜 :: "'a exp ⇒ 'a hyperset"
and 𝒜s :: "'a exp list ⇒ 'a hyperset"
where
"𝒜 (new C) = ⌊{}⌋"
| "𝒜 (Cast C e) = 𝒜 e"
| "𝒜 (Val v) = ⌊{}⌋"
| "𝒜 (e⇩1 «bop» e⇩2) = 𝒜 e⇩1 ⊔ 𝒜 e⇩2"
| "𝒜 (Var V) = ⌊{}⌋"
| "𝒜 (LAss V e) = ⌊{V}⌋ ⊔ 𝒜 e"
| "𝒜 (e∙F{D}) = 𝒜 e"
| "𝒜 (C∙⇩sF{D}) = ⌊{}⌋"
| "𝒜 (e⇩1∙F{D}:=e⇩2) = 𝒜 e⇩1 ⊔ 𝒜 e⇩2"
| "𝒜 (C∙⇩sF{D}:=e⇩2) = 𝒜 e⇩2"
| "𝒜 (e∙M(es)) = 𝒜 e ⊔ 𝒜s es"
| "𝒜 (C∙⇩sM(es)) = 𝒜s es"
| "𝒜 ({V:T; e}) = 𝒜 e ⊖ V"
| "𝒜 (e⇩1;;e⇩2) = 𝒜 e⇩1 ⊔ 𝒜 e⇩2"
| "𝒜 (if (e) e⇩1 else e⇩2) = 𝒜 e ⊔ (𝒜 e⇩1 ⊓ 𝒜 e⇩2)"
| "𝒜 (while (b) e) = 𝒜 b"
| "𝒜 (throw e) = None"
| "𝒜 (try e⇩1 catch(C V) e⇩2) = 𝒜 e⇩1 ⊓ (𝒜 e⇩2 ⊖ V)"
| "𝒜 (INIT C (Cs,b) ← e) = ⌊{}⌋"
| "𝒜 (RI (C,e);Cs ← e') = 𝒜 e"
| "𝒜s ([]) = ⌊{}⌋"
| "𝒜s (e#es) = 𝒜 e ⊔ 𝒜s es"
primrec
𝒟 :: "'a exp ⇒ 'a hyperset ⇒ bool"
and 𝒟s :: "'a exp list ⇒ 'a hyperset ⇒ bool"
where
"𝒟 (new C) A = True"
| "𝒟 (Cast C e) A = 𝒟 e A"
| "𝒟 (Val v) A = True"
| "𝒟 (e⇩1 «bop» e⇩2) A = (𝒟 e⇩1 A ∧ 𝒟 e⇩2 (A ⊔ 𝒜 e⇩1))"
| "𝒟 (Var V) A = (V ∈∈ A)"
| "𝒟 (LAss V e) A = 𝒟 e A"
| "𝒟 (e∙F{D}) A = 𝒟 e A"
| "𝒟 (C∙⇩sF{D}) A = True"
| "𝒟 (e⇩1∙F{D}:=e⇩2) A = (𝒟 e⇩1 A ∧ 𝒟 e⇩2 (A ⊔ 𝒜 e⇩1))"
| "𝒟 (C∙⇩sF{D}:=e⇩2) A = 𝒟 e⇩2 A"
| "𝒟 (e∙M(es)) A = (𝒟 e A ∧ 𝒟s es (A ⊔ 𝒜 e))"
| "𝒟 (C∙⇩sM(es)) A = 𝒟s es A"
| "𝒟 ({V:T; e}) A = 𝒟 e (A ⊖ V)"
| "𝒟 (e⇩1;;e⇩2) A = (𝒟 e⇩1 A ∧ 𝒟 e⇩2 (A ⊔ 𝒜 e⇩1))"
| "𝒟 (if (e) e⇩1 else e⇩2) A =
(𝒟 e A ∧ 𝒟 e⇩1 (A ⊔ 𝒜 e) ∧ 𝒟 e⇩2 (A ⊔ 𝒜 e))"
| "𝒟 (while (e) c) A = (𝒟 e A ∧ 𝒟 c (A ⊔ 𝒜 e))"
| "𝒟 (throw e) A = 𝒟 e A"
| "𝒟 (try e⇩1 catch(C V) e⇩2) A = (𝒟 e⇩1 A ∧ 𝒟 e⇩2 (A ⊔ ⌊{V}⌋))"
| "𝒟 (INIT C (Cs,b) ← e) A = 𝒟 e A"
| "𝒟 (RI (C,e);Cs ← e') A = (𝒟 e A ∧ 𝒟 e' A)"
| "𝒟s ([]) A = True"
| "𝒟s (e#es) A = (𝒟 e A ∧ 𝒟s es (A ⊔ 𝒜 e))"
lemma As_map_Val[simp]: "𝒜s (map Val vs) = ⌊{}⌋"
by (induct vs) simp_all
lemma D_append[iff]: "⋀A. 𝒟s (es @ es') A = (𝒟s es A ∧ 𝒟s es' (A ⊔ 𝒜s es))"
by (induct es type:list) (auto simp:hyperUn_assoc)
lemma A_fv: "⋀A. 𝒜 e = ⌊A⌋ ⟹ A ⊆ fv e"
and "⋀A. 𝒜s es = ⌊A⌋ ⟹ A ⊆ fvs es"
apply(induct e and es rule: 𝒜.induct 𝒜s.induct)
apply (simp_all add:hyperset_defs)
apply blast+
done
lemma sqUn_lem: "A ⊑ A' ⟹ A ⊔ B ⊑ A' ⊔ B"
by(simp add:hyperset_defs) blast
lemma diff_lem: "A ⊑ A' ⟹ A ⊖ b ⊑ A' ⊖ b"
by(simp add:hyperset_defs) blast
lemma D_mono: "⋀A A'. A ⊑ A' ⟹ 𝒟 e A ⟹ 𝒟 (e::'a exp) A'"
and Ds_mono: "⋀A A'. A ⊑ A' ⟹ 𝒟s es A ⟹ 𝒟s (es::'a exp list) A'"
apply(induct e and es rule: 𝒟.induct 𝒟s.induct)
apply simp
apply simp
apply simp
apply simp apply (iprover dest:sqUn_lem)
apply (fastforce simp add:hyperset_defs)
apply simp
apply simp
apply simp
apply simp apply (iprover dest:sqUn_lem)
apply simp
apply simp apply (iprover dest:sqUn_lem)
apply simp
apply simp apply (iprover dest:diff_lem)
apply simp apply (iprover dest:sqUn_lem)
apply simp apply (iprover dest:sqUn_lem)
apply simp apply (iprover dest:sqUn_lem)
apply simp
apply simp apply (iprover dest:sqUn_lem)
apply simp
apply simp
apply simp
apply simp apply (iprover dest:sqUn_lem)
done
lemma D_mono': "𝒟 e A ⟹ A ⊑ A' ⟹ 𝒟 e A'"
and Ds_mono': "𝒟s es A ⟹ A ⊑ A' ⟹ 𝒟s es A'"
by(blast intro:D_mono, blast intro:Ds_mono)
lemma Ds_Vals: "𝒟s (map Val vs) A" by(induct vs, auto)
end
Theory Conform
section ‹ Conformance Relations for Type Soundness Proofs ›
theory Conform
imports Exceptions
begin
definition conf :: "'m prog ⇒ heap ⇒ val ⇒ ty ⇒ bool" ("_,_ ⊢ _ :≤ _" [51,51,51,51] 50)
where
"P,h ⊢ v :≤ T ≡
∃T'. typeof⇘h⇙ v = Some T' ∧ P ⊢ T' ≤ T"
definition oconf :: "'m prog ⇒ heap ⇒ obj ⇒ bool" ("_,_ ⊢ _ √" [51,51,51] 50)
where
"P,h ⊢ obj √ ≡
let (C,fs) = obj in ∀F D T. P ⊢ C has F,NonStatic:T in D ⟶
(∃v. fs(F,D) = Some v ∧ P,h ⊢ v :≤ T)"
definition soconf :: "'m prog ⇒ heap ⇒ cname ⇒ sfields ⇒ bool" ("_,_,_ ⊢⇩s _ √" [51,51,51,51] 50)
where
"P,h,C ⊢⇩s sfs √ ≡
∀F T. P ⊢ C has F,Static:T in C ⟶
(∃v. sfs F = Some v ∧ P,h ⊢ v :≤ T)"
definition hconf :: "'m prog ⇒ heap ⇒ bool" ("_ ⊢ _ √" [51,51] 50)
where
"P ⊢ h √ ≡
(∀a obj. h a = Some obj ⟶ P,h ⊢ obj √) ∧ preallocated h"
definition shconf :: "'m prog ⇒ heap ⇒ sheap ⇒ bool" ("_,_ ⊢⇩s _ √" [51,51,51] 50)
where
"P,h ⊢⇩s sh √ ≡
(∀C sfs i. sh C = Some(sfs,i) ⟶ P,h,C ⊢⇩s sfs √)"
definition lconf :: "'m prog ⇒ heap ⇒ (vname ⇀ val) ⇒ (vname ⇀ ty) ⇒ bool" ("_,_ ⊢ _ '(:≤') _" [51,51,51,51] 50)
where
"P,h ⊢ l (:≤) E ≡
∀V v. l V = Some v ⟶ (∃T. E V = Some T ∧ P,h ⊢ v :≤ T)"
abbreviation
confs :: "'m prog ⇒ heap ⇒ val list ⇒ ty list ⇒ bool"
("_,_ ⊢ _ [:≤] _" [51,51,51,51] 50) where
"P,h ⊢ vs [:≤] Ts ≡ list_all2 (conf P h) vs Ts"
subsection‹ Value conformance @{text":≤"} ›
lemma conf_Null [simp]: "P,h ⊢ Null :≤ T = P ⊢ NT ≤ T"
by (simp (no_asm) add: conf_def)
lemma typeof_conf[simp]: "typeof⇘h⇙ v = Some T ⟹ P,h ⊢ v :≤ T"
by (induct v) (auto simp: conf_def)
lemma typeof_lit_conf[simp]: "typeof v = Some T ⟹ P,h ⊢ v :≤ T"
by (rule typeof_conf[OF typeof_lit_typeof])
lemma defval_conf[simp]: "P,h ⊢ default_val T :≤ T"
by (cases T) (auto simp: conf_def)
lemma conf_upd_obj: "h a = Some(C,fs) ⟹ (P,h(a↦(C,fs')) ⊢ x :≤ T) = (P,h ⊢ x :≤ T)"
by (rule val.induct) (auto simp:conf_def fun_upd_apply)
lemma conf_widen: "P,h ⊢ v :≤ T ⟹ P ⊢ T ≤ T' ⟹ P,h ⊢ v :≤ T'"
by (induct v) (auto intro: widen_trans simp: conf_def)
lemma conf_hext: "h ⊴ h' ⟹ P,h ⊢ v :≤ T ⟹ P,h' ⊢ v :≤ T"
by (induct v) (auto dest: hext_objD simp: conf_def)
lemma conf_ClassD: "P,h ⊢ v :≤ Class C ⟹
v = Null ∨ (∃a obj T. v = Addr a ∧ h a = Some obj ∧ obj_ty obj = T ∧ P ⊢ T ≤ Class C)"
by(induct v) (auto simp: conf_def)
lemma conf_NT [iff]: "P,h ⊢ v :≤ NT = (v = Null)"
by (auto simp add: conf_def)
lemma non_npD: "⟦ v ≠ Null; P,h ⊢ v :≤ Class C ⟧
⟹ ∃a C' fs. v = Addr a ∧ h a = Some(C',fs) ∧ P ⊢ C' ≼⇧* C"
by (auto dest: conf_ClassD)
subsection‹ Value list conformance @{text"[:≤]"} ›
lemma confs_widens [trans]: "⟦P,h ⊢ vs [:≤] Ts; P ⊢ Ts [≤] Ts'⟧ ⟹ P,h ⊢ vs [:≤] Ts'"
by(auto intro: list_all2_trans conf_widen)
lemma confs_rev: "P,h ⊢ rev s [:≤] t = (P,h ⊢ s [:≤] rev t)"
by (simp add: list_all2_rev1)
lemma confs_conv_map:
"⋀Ts'. P,h ⊢ vs [:≤] Ts' = (∃Ts. map typeof⇘h⇙ vs = map Some Ts ∧ P ⊢ Ts [≤] Ts')"
proof(induct vs)
case (Cons a vs)
then show ?case by(case_tac Ts') (auto simp add:conf_def)
qed simp
lemma confs_hext: "P,h ⊢ vs [:≤] Ts ⟹ h ⊴ h' ⟹ P,h' ⊢ vs [:≤] Ts"
by (erule list_all2_mono, erule conf_hext, assumption)
lemma confs_Cons2: "P,h ⊢ xs [:≤] y#ys = (∃z zs. xs = z#zs ∧ P,h ⊢ z :≤ y ∧ P,h ⊢ zs [:≤] ys)"
by (rule list_all2_Cons2)
subsection "Object conformance"
lemma oconf_hext: "P,h ⊢ obj √ ⟹ h ⊴ h' ⟹ P,h' ⊢ obj √"
by (fastforce elim:conf_hext simp: oconf_def)
lemma oconf_blank:
"P ⊢ C has_fields FDTs ⟹ P,h ⊢ blank P C √"
by(fastforce dest: has_fields_fun
simp: has_field_def oconf_def blank_def init_fields_def
map_of_filtered_SomeD)
lemma oconf_fupd [intro?]:
"⟦ P ⊢ C has F,NonStatic:T in D; P,h ⊢ v :≤ T; P,h ⊢ (C,fs) √ ⟧
⟹ P,h ⊢ (C, fs((F,D)↦v)) √"
by (auto dest: has_fields_fun simp add: oconf_def has_field_def fun_upd_apply)
lemmas oconf_new = oconf_hext [OF _ hext_new]
lemmas oconf_upd_obj = oconf_hext [OF _ hext_upd_obj]
subsection "Static object conformance"
lemma soconf_hext: "P,h,C ⊢⇩s obj √ ⟹ h ⊴ h' ⟹ P,h',C ⊢⇩s obj √"
by (fastforce elim:conf_hext simp:soconf_def)
lemma soconf_sblank:
"P ⊢ C has_fields FDTs ⟹ P,h,C ⊢⇩s sblank P C √"
proof -
let ?sfs = "sblank P C"
assume FDTs: "P ⊢ C has_fields FDTs"
then have "⋀F T. P ⊢ C has F,Static:T in C
⟹ ∃v. ?sfs F = Some v ∧ P,h ⊢ v :≤ T"
proof -
fix F T assume has: "P ⊢ C has F,Static:T in C"
with has_fields_fun[OF FDTs] have map: "map_of FDTs (F, C) = ⌊(Static, T)⌋"
by(clarsimp simp: has_field_def)
then have "map_of (map (λ((F, D), b, T). (F, default_val T))
(filter (λ((F, D), b, T). (case ((F, D), b, T) of (x, xa)
⇒ (case x of (F, D) ⇒ λ(b, T). b = Static) xa) ∧ D = C) FDTs)) F
= ⌊default_val T⌋"
by(rule map_of_remove_filtered_SomeD[where P = "default_val"
and Q = "λ((F, D), b, T). b = Static"]) simp
with FDTs show "∃v. ?sfs F = Some v ∧ P,h ⊢ v :≤ T"
by(clarsimp simp: sblank_def init_sfields_def)
qed
then show ?thesis by(simp add: soconf_def)
qed
lemma soconf_fupd [intro?]:
"⟦ P ⊢ C has F,Static:T in C; P,h ⊢ v :≤ T; P,h,C ⊢⇩s sfs √ ⟧
⟹ P,h,C ⊢⇩s sfs(F↦v) √"
by (auto dest: has_fields_fun simp add: fun_upd_apply soconf_def has_field_def)
lemmas soconf_new = soconf_hext [OF _ hext_new]
lemmas soconf_upd_obj = soconf_hext [OF _ hext_upd_obj]
subsection "Heap conformance"
lemma hconfD: "⟦ P ⊢ h √; h a = Some obj ⟧ ⟹ P,h ⊢ obj √"
by (unfold hconf_def) fast
lemma hconf_new: "⟦ P ⊢ h √; h a = None; P,h ⊢ obj √ ⟧ ⟹ P ⊢ h(a↦obj) √"
by (unfold hconf_def) (auto intro: oconf_new preallocated_new)
lemma hconf_upd_obj: "⟦ P ⊢ h√; h a = Some(C,fs); P,h ⊢ (C,fs')√ ⟧ ⟹ P ⊢ h(a↦(C,fs'))√"
by (unfold hconf_def) (auto intro: oconf_upd_obj preallocated_upd_obj)
subsection "Class statics conformance"
lemma shconfD: "⟦ P,h ⊢⇩s sh √; sh C = Some(sfs,i) ⟧ ⟹ P,h,C ⊢⇩s sfs √"
by (unfold shconf_def) fast
lemma shconf_upd_obj: "⟦ P,h ⊢⇩s sh √; P,h,C ⊢⇩s sfs' √ ⟧
⟹ P,h ⊢⇩s sh(C↦(sfs',i'))√"
by (unfold shconf_def) (auto intro: soconf_upd_obj preallocated_upd_obj)
lemma shconf_hnew: "⟦ P,h ⊢⇩s sh √; h a = None ⟧ ⟹ P,h(a↦obj) ⊢⇩s sh √"
by (unfold shconf_def) (auto intro: soconf_new preallocated_new)
lemma shconf_hupd_obj: "⟦ P,h ⊢⇩s sh √; h a = Some(C,fs) ⟧ ⟹ P,h(a↦(C,fs')) ⊢⇩s sh √"
by (unfold shconf_def) (auto intro: soconf_upd_obj preallocated_upd_obj)
subsection "Local variable conformance"
lemma lconf_hext: "⟦ P,h ⊢ l (:≤) E; h ⊴ h' ⟧ ⟹ P,h' ⊢ l (:≤) E"
by (unfold lconf_def) (fast elim: conf_hext)
lemma lconf_upd:
"⟦ P,h ⊢ l (:≤) E; P,h ⊢ v :≤ T; E V = Some T ⟧ ⟹ P,h ⊢ l(V↦v) (:≤) E"
by (unfold lconf_def) auto
lemma lconf_empty[iff]: "P,h ⊢ Map.empty (:≤) E"
by(simp add:lconf_def)
lemma lconf_upd2: "⟦P,h ⊢ l (:≤) E; P,h ⊢ v :≤ T⟧ ⟹ P,h ⊢ l(V↦v) (:≤) E(V↦T)"
by(simp add:lconf_def)
end
Theory SmallStep
section ‹ Small Step Semantics ›
theory SmallStep
imports Expr State WWellForm
begin
fun blocks :: "vname list * ty list * val list * expr ⇒ expr"
where
"blocks(V#Vs, T#Ts, v#vs, e) = {V:T := Val v; blocks(Vs,Ts,vs,e)}"
|"blocks([],[],[],e) = e"
lemmas blocks_induct = blocks.induct[split_format (complete)]
lemma [simp]:
"⟦ size vs = size Vs; size Ts = size Vs ⟧ ⟹ fv(blocks(Vs,Ts,vs,e)) = fv e - set Vs"
by (induct rule:blocks_induct) auto
lemma sub_RI_blocks_body[iff]: "length vs = length pns ⟹ length Ts = length pns
⟹ sub_RI (blocks (pns, Ts, vs, body)) ⟷ sub_RI body"
proof(induct pns arbitrary: Ts vs)
case Nil then show ?case by simp
next
case Cons then show ?case by(cases vs; cases Ts) auto
qed
definition assigned :: "'a ⇒ 'a exp ⇒ bool"
where
"assigned V e ≡ ∃v e'. e = (V := Val v;; e')"
fun icheck :: "'m prog ⇒ cname ⇒ 'a exp ⇒ bool" where
"icheck P C' (new C) = (C' = C)" |
"icheck P D' (C∙⇩sF{D}) = ((D' = D) ∧ (∃T. P ⊢ C has F,Static:T in D))" |
"icheck P D' (C∙⇩sF{D}:=(Val v)) = ((D' = D) ∧ (∃T. P ⊢ C has F,Static:T in D))" |
"icheck P D (C∙⇩sM(es)) = ((∃vs. es = map Val vs) ∧ (∃Ts T m. P ⊢ C sees M,Static:Ts→T = m in D))" |
"icheck P _ _ = False"
lemma nicheck_SFAss_nonVal: "val_of e⇩2 = None ⟹ ¬icheck P C' (C∙⇩sF{D} := (e⇩2::'a exp))"
by(rule notI, cases e⇩2, auto)
inductive_set
red :: "J_prog ⇒ ((expr × state × bool) × (expr × state × bool)) set"
and reds :: "J_prog ⇒ ((expr list × state × bool) × (expr list × state × bool)) set"
and red' :: "J_prog ⇒ expr ⇒ state ⇒ bool ⇒ expr ⇒ state ⇒ bool ⇒ bool"
("_ ⊢ ((1⟨_,/_,/_⟩) →/ (1⟨_,/_,/_⟩))" [51,0,0,0,0,0,0] 81)
and reds' :: "J_prog ⇒ expr list ⇒ state ⇒ bool ⇒ expr list ⇒ state ⇒ bool ⇒ bool"
("_ ⊢ ((1⟨_,/_,/_⟩) [→]/ (1⟨_,/_,/_⟩))" [51,0,0,0,0,0,0] 81)
for P :: J_prog
where
"P ⊢ ⟨e,s,b⟩ → ⟨e',s',b'⟩ ≡ ((e,s,b), e',s',b') ∈ red P"
| "P ⊢ ⟨es,s,b⟩ [→] ⟨es',s',b'⟩ ≡ ((es,s,b), es',s',b') ∈ reds P"
| RedNew:
"⟦ new_Addr h = Some a; P ⊢ C has_fields FDTs; h' = h(a↦blank P C) ⟧
⟹ P ⊢ ⟨new C, (h,l,sh), True⟩ → ⟨addr a, (h',l,sh), False⟩"
| RedNewFail:
"⟦ new_Addr h = None; is_class P C ⟧ ⟹
P ⊢ ⟨new C, (h,l,sh), True⟩ → ⟨THROW OutOfMemory, (h,l,sh), False⟩"
| NewInitDoneRed:
"sh C = Some (sfs, Done) ⟹
P ⊢ ⟨new C, (h,l,sh), False⟩ → ⟨new C, (h,l,sh), True⟩"
| NewInitRed:
"⟦ ∄sfs. sh C = Some (sfs, Done); is_class P C ⟧
⟹ P ⊢ ⟨new C,(h,l,sh),False⟩ → ⟨INIT C ([C],False) ← new C,(h,l,sh),False⟩"
| CastRed:
"P ⊢ ⟨e,s,b⟩ → ⟨e',s',b'⟩ ⟹
P ⊢ ⟨Cast C e, s, b⟩ → ⟨Cast C e', s', b'⟩"
| RedCastNull:
"P ⊢ ⟨Cast C null, s, b⟩ → ⟨null,s,b⟩"
| RedCast:
"⟦ h a = Some(D,fs); P ⊢ D ≼⇧* C ⟧
⟹ P ⊢ ⟨Cast C (addr a), (h,l,sh), b⟩ → ⟨addr a, (h,l,sh), b⟩"
| RedCastFail:
"⟦ h a = Some(D,fs); ¬ P ⊢ D ≼⇧* C ⟧
⟹ P ⊢ ⟨Cast C (addr a), (h,l,sh), b⟩ → ⟨THROW ClassCast, (h,l,sh), b⟩"
| BinOpRed1:
"P ⊢ ⟨e,s,b⟩ → ⟨e',s',b'⟩ ⟹
P ⊢ ⟨e «bop» e⇩2, s, b⟩ → ⟨e' «bop» e⇩2, s', b'⟩"
| BinOpRed2:
"P ⊢ ⟨e,s,b⟩ → ⟨e',s',b'⟩ ⟹
P ⊢ ⟨(Val v⇩1) «bop» e, s, b⟩ → ⟨(Val v⇩1) «bop» e', s', b'⟩"
| RedBinOp:
"binop(bop,v⇩1,v⇩2) = Some v ⟹
P ⊢ ⟨(Val v⇩1) «bop» (Val v⇩2), s, b⟩ → ⟨Val v,s,b⟩"
| RedVar:
"l V = Some v ⟹
P ⊢ ⟨Var V,(h,l,sh),b⟩ → ⟨Val v,(h,l,sh),b⟩"
| LAssRed:
"P ⊢ ⟨e,s,b⟩ → ⟨e',s',b'⟩ ⟹
P ⊢ ⟨V:=e,s,b⟩ → ⟨V:=e',s',b'⟩"
| RedLAss:
"P ⊢ ⟨V:=(Val v), (h,l,sh), b⟩ → ⟨unit, (h,l(V↦v),sh), b⟩"
| FAccRed:
"P ⊢ ⟨e,s,b⟩ → ⟨e',s',b'⟩ ⟹
P ⊢ ⟨e∙F{D}, s, b⟩ → ⟨e'∙F{D}, s', b'⟩"
| RedFAcc:
"⟦ h a = Some(C,fs); fs(F,D) = Some v;
P ⊢ C has F,NonStatic:t in D ⟧
⟹ P ⊢ ⟨(addr a)∙F{D}, (h,l,sh), b⟩ → ⟨Val v,(h,l,sh),b⟩"
| RedFAccNull:
"P ⊢ ⟨null∙F{D}, s, b⟩ → ⟨THROW NullPointer, s, b⟩"
| RedFAccNone:
"⟦ h a = Some(C,fs); ¬(∃b t. P ⊢ C has F,b:t in D) ⟧
⟹ P ⊢ ⟨(addr a)∙F{D},(h,l,sh),b⟩ → ⟨THROW NoSuchFieldError,(h,l,sh),b⟩"
| RedFAccStatic:
"⟦ h a = Some(C,fs); P ⊢ C has F,Static:t in D ⟧
⟹ P ⊢ ⟨(addr a)∙F{D},(h,l,sh),b⟩ → ⟨THROW IncompatibleClassChangeError,(h,l,sh),b⟩"
| RedSFAcc:
"⟦ P ⊢ C has F,Static:t in D;
sh D = Some (sfs,i);
sfs F = Some v ⟧
⟹ P ⊢ ⟨C∙⇩sF{D},(h,l,sh),True⟩ → ⟨Val v,(h,l,sh),False⟩"
| SFAccInitDoneRed:
"⟦ P ⊢ C has F,Static:t in D;
sh D = Some (sfs,Done) ⟧
⟹ P ⊢ ⟨C∙⇩sF{D},(h,l,sh),False⟩ → ⟨C∙⇩sF{D},(h,l,sh),True⟩"
| SFAccInitRed:
"⟦ P ⊢ C has F,Static:t in D;
∄sfs. sh D = Some (sfs,Done) ⟧
⟹ P ⊢ ⟨C∙⇩sF{D},(h,l,sh),False⟩ → ⟨INIT D ([D],False) ← C∙⇩sF{D},(h,l,sh),False⟩"
| RedSFAccNone:
"¬(∃b t. P ⊢ C has F,b:t in D)
⟹ P ⊢ ⟨C∙⇩sF{D},(h,l,sh),b⟩ → ⟨THROW NoSuchFieldError,(h,l,sh),False⟩"
| RedSFAccNonStatic:
"P ⊢ C has F,NonStatic:t in D
⟹ P ⊢ ⟨C∙⇩sF{D},(h,l,sh),b⟩ → ⟨THROW IncompatibleClassChangeError,(h,l,sh),False⟩"
| FAssRed1:
"P ⊢ ⟨e,s,b⟩ → ⟨e',s',b'⟩ ⟹
P ⊢ ⟨e∙F{D}:=e⇩2, s, b⟩ → ⟨e'∙F{D}:=e⇩2, s', b'⟩"
| FAssRed2:
"P ⊢ ⟨e,s,b⟩ → ⟨e',s',b'⟩ ⟹
P ⊢ ⟨Val v∙F{D}:=e, s, b⟩ → ⟨Val v∙F{D}:=e', s', b'⟩"
| RedFAss:
"⟦ P ⊢ C has F,NonStatic:t in D; h a = Some(C,fs) ⟧ ⟹
P ⊢ ⟨(addr a)∙F{D}:=(Val v), (h,l,sh), b⟩ → ⟨unit, (h(a ↦ (C,fs((F,D) ↦ v))),l,sh), b⟩"
| RedFAssNull:
"P ⊢ ⟨null∙F{D}:=Val v, s, b⟩ → ⟨THROW NullPointer, s, b⟩"
| RedFAssNone:
"⟦ h a = Some(C,fs); ¬(∃b t. P ⊢ C has F,b:t in D) ⟧
⟹ P ⊢ ⟨(addr a)∙F{D}:=(Val v),(h,l,sh),b⟩ → ⟨THROW NoSuchFieldError,(h,l,sh),b⟩"
| RedFAssStatic:
"⟦ h a = Some(C,fs); P ⊢ C has F,Static:t in D ⟧
⟹ P ⊢ ⟨(addr a)∙F{D}:=(Val v),(h,l,sh),b⟩ → ⟨THROW IncompatibleClassChangeError,(h,l,sh),b⟩"
| SFAssRed:
"P ⊢ ⟨e,s,b⟩ → ⟨e',s',b'⟩ ⟹
P ⊢ ⟨C∙⇩sF{D}:=e, s, b⟩ → ⟨C∙⇩sF{D}:=e', s', b'⟩"
| RedSFAss:
"⟦ P ⊢ C has F,Static:t in D;
sh D = Some(sfs,i);
sfs' = sfs(F↦v); sh' = sh(D↦(sfs',i)) ⟧
⟹ P ⊢ ⟨C∙⇩sF{D}:=(Val v),(h,l,sh),True⟩ → ⟨unit,(h,l,sh'),False⟩"
| SFAssInitDoneRed:
"⟦ P ⊢ C has F,Static:t in D;
sh D = Some(sfs,Done) ⟧
⟹ P ⊢ ⟨C∙⇩sF{D}:=(Val v),(h,l,sh),False⟩ → ⟨C∙⇩sF{D}:=(Val v),(h,l,sh),True⟩"
| SFAssInitRed:
"⟦ P ⊢ C has F,Static:t in D;
∄sfs. sh D = Some(sfs,Done) ⟧
⟹ P ⊢ ⟨C∙⇩sF{D}:=(Val v),(h,l,sh),False⟩ → ⟨INIT D ([D],False)← C∙⇩sF{D}:=(Val v),(h,l,sh),False⟩"
| RedSFAssNone:
"¬(∃b t. P ⊢ C has F,b:t in D)
⟹ P ⊢ ⟨C∙⇩sF{D}:=(Val v),s,b⟩ → ⟨THROW NoSuchFieldError,s,False⟩"
| RedSFAssNonStatic:
"P ⊢ C has F,NonStatic:t in D
⟹ P ⊢ ⟨C∙⇩sF{D}:=(Val v),s,b⟩ → ⟨THROW IncompatibleClassChangeError,s,False⟩"
| CallObj:
"P ⊢ ⟨e,s,b⟩ → ⟨e',s',b'⟩ ⟹
P ⊢ ⟨e∙M(es),s,b⟩ → ⟨e'∙M(es),s',b'⟩"
| CallParams:
"P ⊢ ⟨es,s,b⟩ [→] ⟨es',s',b'⟩ ⟹
P ⊢ ⟨(Val v)∙M(es),s,b⟩ → ⟨(Val v)∙M(es'),s',b'⟩"
| RedCall:
"⟦ h a = Some(C,fs); P ⊢ C sees M,NonStatic:Ts→T = (pns,body) in D; size vs = size pns; size Ts = size pns ⟧
⟹ P ⊢ ⟨(addr a)∙M(map Val vs), (h,l,sh), b⟩ → ⟨blocks(this#pns, Class D#Ts, Addr a#vs, body), (h,l,sh), b⟩"
| RedCallNull:
"P ⊢ ⟨null∙M(map Val vs),s,b⟩ → ⟨THROW NullPointer,s,b⟩"
| RedCallNone:
"⟦ h a = Some(C,fs); ¬(∃b Ts T m D. P ⊢ C sees M,b:Ts→T = m in D) ⟧
⟹ P ⊢ ⟨(addr a)∙M(map Val vs),(h,l,sh),b⟩ → ⟨THROW NoSuchMethodError,(h,l,sh),b⟩"
| RedCallStatic:
"⟦ h a = Some(C,fs); P ⊢ C sees M,Static:Ts→T = m in D ⟧
⟹ P ⊢ ⟨(addr a)∙M(map Val vs),(h,l,sh),b⟩ → ⟨THROW IncompatibleClassChangeError,(h,l,sh),b⟩"
| SCallParams:
"P ⊢ ⟨es,s,b⟩ [→] ⟨es',s',b'⟩ ⟹
P ⊢ ⟨C∙⇩sM(es),s,b⟩ → ⟨C∙⇩sM(es'),s',b'⟩"
| RedSCall:
"⟦ P ⊢ C sees M,Static:Ts→T = (pns,body) in D;
length vs = length pns; size Ts = size pns ⟧
⟹ P ⊢ ⟨C∙⇩sM(map Val vs),s,True⟩ → ⟨blocks(pns, Ts, vs, body), s, False⟩"
| SCallInitDoneRed:
"⟦ P ⊢ C sees M,Static:Ts→T = (pns,body) in D;
sh D = Some(sfs,Done) ∨ (M = clinit ∧ sh D = Some(sfs,Processing)) ⟧
⟹ P ⊢ ⟨C∙⇩sM(map Val vs),(h,l,sh), False⟩ → ⟨C∙⇩sM(map Val vs),(h,l,sh), True⟩"
| SCallInitRed:
"⟦ P ⊢ C sees M,Static:Ts→T = (pns,body) in D;
∄sfs. sh D = Some(sfs,Done); M ≠ clinit ⟧
⟹ P ⊢ ⟨C∙⇩sM(map Val vs),(h,l,sh), False⟩ → ⟨INIT D ([D],False) ← C∙⇩sM(map Val vs),(h,l,sh),False⟩"
| RedSCallNone:
"⟦ ¬(∃b Ts T m D. P ⊢ C sees M,b:Ts→T = m in D) ⟧
⟹ P ⊢ ⟨C∙⇩sM(map Val vs),s,b⟩ → ⟨THROW NoSuchMethodError,s,False⟩"
| RedSCallNonStatic:
"⟦ P ⊢ C sees M,NonStatic:Ts→T = m in D ⟧
⟹ P ⊢ ⟨C∙⇩sM(map Val vs),s,b⟩ → ⟨THROW IncompatibleClassChangeError,s,False⟩"
| BlockRedNone:
"⟦ P ⊢ ⟨e, (h,l(V:=None),sh), b⟩ → ⟨e', (h',l',sh'), b'⟩; l' V = None; ¬ assigned V e ⟧
⟹ P ⊢ ⟨{V:T; e}, (h,l,sh), b⟩ → ⟨{V:T; e'}, (h',l'(V := l V),sh'), b'⟩"
| BlockRedSome:
"⟦ P ⊢ ⟨e, (h,l(V:=None),sh), b⟩ → ⟨e', (h',l',sh'), b'⟩; l' V = Some v;¬ assigned V e ⟧
⟹ P ⊢ ⟨{V:T; e}, (h,l,sh), b⟩ → ⟨{V:T := Val v; e'}, (h',l'(V := l V),sh'), b'⟩"
| InitBlockRed:
"⟦ P ⊢ ⟨e, (h,l(V↦v),sh), b⟩ → ⟨e', (h',l',sh'), b'⟩; l' V = Some v' ⟧
⟹ P ⊢ ⟨{V:T := Val v; e}, (h,l,sh), b⟩ → ⟨{V:T := Val v'; e'}, (h',l'(V := l V),sh'), b'⟩"
| RedBlock:
"P ⊢ ⟨{V:T; Val u}, s, b⟩ → ⟨Val u, s, b⟩"
| RedInitBlock:
"P ⊢ ⟨{V:T := Val v; Val u}, s, b⟩ → ⟨Val u, s, b⟩"
| SeqRed:
"P ⊢ ⟨e,s,b⟩ → ⟨e',s',b'⟩ ⟹
P ⊢ ⟨e;;e⇩2, s, b⟩ → ⟨e';;e⇩2, s', b'⟩"
| RedSeq:
"P ⊢ ⟨(Val v);;e⇩2, s, b⟩ → ⟨e⇩2, s, b⟩"
| CondRed:
"P ⊢ ⟨e,s,b⟩ → ⟨e',s',b'⟩ ⟹
P ⊢ ⟨if (e) e⇩1 else e⇩2, s, b⟩ → ⟨if (e') e⇩1 else e⇩2, s', b'⟩"
| RedCondT:
"P ⊢ ⟨if (true) e⇩1 else e⇩2, s, b⟩ → ⟨e⇩1, s, b⟩"
| RedCondF:
"P ⊢ ⟨if (false) e⇩1 else e⇩2, s, b⟩ → ⟨e⇩2, s, b⟩"
| RedWhile:
"P ⊢ ⟨while(b) c, s, b'⟩ → ⟨if(b) (c;;while(b) c) else unit, s, b'⟩"
| ThrowRed:
"P ⊢ ⟨e,s,b⟩ → ⟨e',s',b'⟩ ⟹
P ⊢ ⟨throw e, s, b⟩ → ⟨throw e', s', b'⟩"
| RedThrowNull:
"P ⊢ ⟨throw null, s, b⟩ → ⟨THROW NullPointer, s, b⟩"
| TryRed:
"P ⊢ ⟨e,s,b⟩ → ⟨e',s',b'⟩ ⟹
P ⊢ ⟨try e catch(C V) e⇩2, s, b⟩ → ⟨try e' catch(C V) e⇩2, s', b'⟩"
| RedTry:
"P ⊢ ⟨try (Val v) catch(C V) e⇩2, s, b⟩ → ⟨Val v, s, b⟩"
| RedTryCatch:
"⟦ hp s a = Some(D,fs); P ⊢ D ≼⇧* C ⟧
⟹ P ⊢ ⟨try (Throw a) catch(C V) e⇩2, s, b⟩ → ⟨{V:Class C := addr a; e⇩2}, s, b⟩"
| RedTryFail:
"⟦ hp s a = Some(D,fs); ¬ P ⊢ D ≼⇧* C ⟧
⟹ P ⊢ ⟨try (Throw a) catch(C V) e⇩2, s, b⟩ → ⟨Throw a, s, b⟩"
| ListRed1:
"P ⊢ ⟨e,s,b⟩ → ⟨e',s',b'⟩ ⟹
P ⊢ ⟨e#es,s,b⟩ [→] ⟨e'#es,s',b'⟩"
| ListRed2:
"P ⊢ ⟨es,s,b⟩ [→] ⟨es',s',b'⟩ ⟹
P ⊢ ⟨Val v # es,s,b⟩ [→] ⟨Val v # es',s',b'⟩"
| RedInit:
"¬sub_RI e ⟹ P ⊢ ⟨INIT C (Nil,b) ← e,s,b'⟩ → ⟨e,s,icheck P C e⟩"
| InitNoneRed:
"sh C = None
⟹ P ⊢ ⟨INIT C' (C#Cs,False) ← e,(h,l,sh),b⟩ → ⟨INIT C' (C#Cs,False) ← e,(h,l,sh(C ↦ (sblank P C, Prepared))),b⟩"
| RedInitDone:
"sh C = Some(sfs,Done)
⟹ P ⊢ ⟨INIT C' (C#Cs,False) ← e,(h,l,sh),b⟩ → ⟨INIT C' (Cs,True) ← e,(h,l,sh),b⟩"
| RedInitProcessing:
"sh C = Some(sfs,Processing)
⟹ P ⊢ ⟨INIT C' (C#Cs,False) ← e,(h,l,sh),b⟩ → ⟨INIT C' (Cs,True) ← e,(h,l,sh),b⟩"
| RedInitError:
"sh C = Some(sfs,Error)
⟹ P ⊢ ⟨INIT C' (C#Cs,False) ← e,(h,l,sh),b⟩ → ⟨RI (C,THROW NoClassDefFoundError);Cs ← e,(h,l,sh),b⟩"
| InitObjectRed:
"⟦ sh C = Some(sfs,Prepared);
C = Object;
sh' = sh(C ↦ (sfs,Processing)) ⟧
⟹ P ⊢ ⟨INIT C' (C#Cs,False) ← e,(h,l,sh),b⟩ → ⟨INIT C' (C#Cs,True) ← e,(h,l,sh'),b⟩"
| InitNonObjectSuperRed:
"⟦ sh C = Some(sfs,Prepared);
C ≠ Object;
class P C = Some (D,r);
sh' = sh(C ↦ (sfs,Processing)) ⟧
⟹ P ⊢ ⟨INIT C' (C#Cs,False) ← e,(h,l,sh),b⟩ → ⟨INIT C' (D#C#Cs,False) ← e,(h,l,sh'),b⟩"
| RedInitRInit:
"P ⊢ ⟨INIT C' (C#Cs,True) ← e,(h,l,sh),b⟩ → ⟨RI (C,C∙⇩sclinit([]));Cs ← e,(h,l,sh),b⟩"
| RInitRed:
"P ⊢ ⟨e,s,b⟩ → ⟨e',s',b'⟩ ⟹
P ⊢ ⟨RI (C,e);Cs ← e⇩0, s, b⟩ → ⟨RI (C,e');Cs ← e⇩0, s', b'⟩"
| RedRInit:
"⟦ sh C = Some (sfs, i);
sh' = sh(C ↦ (sfs,Done));
C' = last(C#Cs) ⟧ ⟹
P ⊢ ⟨RI (C, Val v);Cs ← e, (h,l,sh), b⟩ → ⟨INIT C' (Cs,True) ← e, (h,l,sh'), b⟩"
| CastThrow: "P ⊢ ⟨Cast C (throw e), s, b⟩ → ⟨throw e, s, b⟩"
| BinOpThrow1: "P ⊢ ⟨(throw e) «bop» e⇩2, s, b⟩ → ⟨throw e, s, b⟩"
| BinOpThrow2: "P ⊢ ⟨(Val v⇩1) «bop» (throw e), s, b⟩ → ⟨throw e, s, b⟩"
| LAssThrow: "P ⊢ ⟨V:=(throw e), s, b⟩ → ⟨throw e, s, b⟩"
| FAccThrow: "P ⊢ ⟨(throw e)∙F{D}, s, b⟩ → ⟨throw e, s, b⟩"
| FAssThrow1: "P ⊢ ⟨(throw e)∙F{D}:=e⇩2, s, b⟩ → ⟨throw e, s, b⟩"
| FAssThrow2: "P ⊢ ⟨Val v∙F{D}:=(throw e), s, b⟩ → ⟨throw e, s, b⟩"
| SFAssThrow: "P ⊢ ⟨C∙⇩sF{D}:=(throw e), s, b⟩ → ⟨throw e, s, b⟩"
| CallThrowObj: "P ⊢ ⟨(throw e)∙M(es), s, b⟩ → ⟨throw e, s, b⟩"
| CallThrowParams: "⟦ es = map Val vs @ throw e # es' ⟧ ⟹ P ⊢ ⟨(Val v)∙M(es), s, b⟩ → ⟨throw e, s, b⟩"
| SCallThrowParams: "⟦ es = map Val vs @ throw e # es' ⟧ ⟹ P ⊢ ⟨C∙⇩sM(es), s, b⟩ → ⟨throw e, s, b⟩"
| BlockThrow: "P ⊢ ⟨{V:T; Throw a}, s, b⟩ → ⟨Throw a, s, b⟩"
| InitBlockThrow: "P ⊢ ⟨{V:T := Val v; Throw a}, s, b⟩ → ⟨Throw a, s, b⟩"
| SeqThrow: "P ⊢ ⟨(throw e);;e⇩2, s, b⟩ → ⟨throw e, s, b⟩"
| CondThrow: "P ⊢ ⟨if (throw e) e⇩1 else e⇩2, s, b⟩ → ⟨throw e, s, b⟩"
| ThrowThrow: "P ⊢ ⟨throw(throw e), s, b⟩ → ⟨throw e, s, b⟩"
| RInitInitThrow: "⟦ sh C = Some(sfs,i); sh' = sh(C ↦ (sfs,Error)) ⟧ ⟹
P ⊢ ⟨RI (C,Throw a);D#Cs ← e,(h,l,sh),b⟩ → ⟨RI (D,Throw a);Cs ← e,(h,l,sh'),b⟩"
| RInitThrow: "⟦ sh C = Some(sfs, i); sh' = sh(C ↦ (sfs,Error)) ⟧ ⟹
P ⊢ ⟨RI (C,Throw a);Nil ← e,(h,l,sh),b⟩ → ⟨Throw a,(h,l,sh'),b⟩"
lemmas red_reds_induct = red_reds.induct [split_format (complete)]
and red_reds_inducts = red_reds.inducts [split_format (complete)]
inductive_cases [elim!]:
"P ⊢ ⟨V:=e,s,b⟩ → ⟨e',s',b'⟩"
"P ⊢ ⟨e1;;e2,s,b⟩ → ⟨e',s',b'⟩"
subsection‹ The reflexive transitive closure ›
abbreviation
Step :: "J_prog ⇒ expr ⇒ state ⇒ bool ⇒ expr ⇒ state ⇒ bool ⇒ bool"
("_ ⊢ ((1⟨_,/_,/_⟩) →*/ (1⟨_,/_,/_⟩))" [51,0,0,0,0,0,0] 81)
where "P ⊢ ⟨e,s,b⟩ →* ⟨e',s',b'⟩ ≡ ((e,s,b), e',s',b') ∈ (red P)⇧*"
abbreviation
Steps :: "J_prog ⇒ expr list ⇒ state ⇒ bool ⇒ expr list ⇒ state ⇒ bool ⇒ bool"
("_ ⊢ ((1⟨_,/_,/_⟩) [→]*/ (1⟨_,/_,/_⟩))" [51,0,0,0,0,0,0] 81)
where "P ⊢ ⟨es,s,b⟩ [→]* ⟨es',s',b'⟩ ≡ ((es,s,b), es',s',b') ∈ (reds P)⇧*"
lemmas converse_rtrancl_induct3 =
converse_rtrancl_induct [of "(ax, ay, az)" "(bx, by, bz)", split_format (complete),
consumes 1, case_names refl step]
lemma converse_rtrancl_induct_red[consumes 1]:
assumes "P ⊢ ⟨e,(h,l,sh),b⟩ →* ⟨e',(h',l',sh'),b'⟩"
and "⋀e h l sh b. R e h l sh b e h l sh b"
and "⋀e⇩0 h⇩0 l⇩0 sh⇩0 b⇩0 e⇩1 h⇩1 l⇩1 sh⇩1 b⇩1 e' h' l' sh' b'.
⟦ P ⊢ ⟨e⇩0,(h⇩0,l⇩0,sh⇩0),b⇩0⟩ → ⟨e⇩1,(h⇩1,l⇩1,sh⇩1),b⇩1⟩; R e⇩1 h⇩1 l⇩1 sh⇩1 b⇩1 e' h' l' sh' b' ⟧
⟹ R e⇩0 h⇩0 l⇩0 sh⇩0 b⇩0 e' h' l' sh' b'"
shows "R e h l sh b e' h' l' sh' b'"
proof -
{ fix s s'
assume reds: "P ⊢ ⟨e,s,b⟩ →* ⟨e',s',b'⟩"
and base: "⋀e s b. R e (hp s) (lcl s) (shp s) b e (hp s) (lcl s) (shp s) b"
and red⇩1: "⋀e⇩0 s⇩0 b⇩0 e⇩1 s⇩1 b⇩1 e' s' b'.
⟦ P ⊢ ⟨e⇩0,s⇩0,b⇩0⟩ → ⟨e⇩1,s⇩1,b⇩1⟩; R e⇩1 (hp s⇩1) (lcl s⇩1) (shp s⇩1) b⇩1 e' (hp s') (lcl s') (shp s') b' ⟧
⟹ R e⇩0 (hp s⇩0) (lcl s⇩0) (shp s⇩0) b⇩0 e' (hp s') (lcl s') (shp s') b'"
from reds have "R e (hp s) (lcl s) (shp s) b e' (hp s') (lcl s') (shp s') b'"
proof (induct rule:converse_rtrancl_induct3)
case refl show ?case by(rule base)
next
case step
thus ?case by(blast intro:red⇩1)
qed
}
with assms show ?thesis by fastforce
qed
subsection‹Some easy lemmas›
lemma [iff]: "¬ P ⊢ ⟨[],s,b⟩ [→] ⟨es',s',b'⟩"
by(blast elim: reds.cases)
lemma [iff]: "¬ P ⊢ ⟨Val v,s,b⟩ → ⟨e',s',b'⟩"
by(fastforce elim: red.cases)
lemma val_no_step: "val_of e = ⌊v⌋ ⟹ ¬ P ⊢ ⟨e,s,b⟩ → ⟨e',s',b'⟩"
by(drule val_of_spec, simp)
lemma [iff]: "¬ P ⊢ ⟨Throw a,s,b⟩ → ⟨e',s',b'⟩"
by(fastforce elim: red.cases)
lemma map_Vals_no_step [iff]: "¬ P ⊢ ⟨map Val vs,s,b⟩ [→] ⟨es',s',b'⟩"
apply(induct vs arbitrary: es', simp)
apply(rule notI)
apply(erule reds.cases, auto)
done
lemma vals_no_step: "map_vals_of es = ⌊vs⌋ ⟹ ¬ P ⊢ ⟨es,s,b⟩ [→] ⟨es',s',b'⟩"
by(drule map_vals_of_spec, simp)
lemma vals_throw_no_step [iff]: "¬ P ⊢ ⟨map Val vs @ Throw a # es,s,b⟩ [→] ⟨es',s',b'⟩"
apply(induct vs arbitrary: es', auto)
apply(erule reds.cases, auto)
apply(erule reds.cases, auto)
done
lemma lass_val_of_red:
"⟦ lass_val_of e = ⌊a⌋; P ⊢ ⟨e,(h, l, sh),b⟩ → ⟨e',(h', l', sh'),b'⟩ ⟧
⟹ e' = unit ∧ h' = h ∧ l' = l(fst a↦snd a) ∧ sh' = sh ∧ b = b'"
by(drule lass_val_of_spec, auto)
lemma final_no_step [iff]: "final e ⟹ ¬ P ⊢ ⟨e,s,b⟩ → ⟨e',s',b'⟩"
by(erule finalE, simp+)
lemma finals_no_step [iff]: "finals es ⟹ ¬ P ⊢ ⟨es,s,b⟩ [→] ⟨es',s',b'⟩"
by(erule finalsE, simp+)
lemma reds_final_same:
"P ⊢ ⟨e,s,b⟩ →* ⟨e',s',b'⟩ ⟹ final e ⟹ e = e' ∧ s = s' ∧ b = b'"
proof(induct rule:converse_rtrancl_induct3)
case refl show ?case by simp
next
case (step e0 s0 b0 e1 s1 b1) show ?case
proof(rule finalE[OF step.prems(1)])
fix v assume "e0 = Val v" then show ?thesis using step by simp
next
fix a assume "e0 = Throw a" then show ?thesis using step by simp
qed
qed
lemma reds_throw:
"P ⊢ ⟨e,s,b⟩ →* ⟨e',s',b'⟩ ⟹ (⋀e⇩t. throw_of e = ⌊e⇩t⌋ ⟹ ∃e⇩t'. throw_of e' = ⌊e⇩t'⌋)"
proof(induct rule:converse_rtrancl_induct3)
case refl then show ?case by simp
next
case (step e0 s0 b0 e1 s1 b1)
then show ?case by(auto elim: red.cases)
qed
lemma red_hext_incr: "P ⊢ ⟨e,(h,l,sh),b⟩ → ⟨e',(h',l',sh'),b'⟩ ⟹ h ⊴ h'"
and reds_hext_incr: "P ⊢ ⟨es,(h,l,sh),b⟩ [→] ⟨es',(h',l',sh'),b'⟩ ⟹ h ⊴ h'"
proof(induct rule:red_reds_inducts)
case RedNew thus ?case
by(fastforce dest:new_Addr_SomeD simp:hext_def split:if_splits)
next
case RedFAss thus ?case by(simp add:hext_def split:if_splits)
qed simp_all
lemma red_lcl_incr: "P ⊢ ⟨e,(h⇩0,l⇩0,sh⇩0),b⟩ → ⟨e',(h⇩1,l⇩1,sh⇩1),b'⟩ ⟹ dom l⇩0 ⊆ dom l⇩1"
and reds_lcl_incr: "P ⊢ ⟨es,(h⇩0,l⇩0,sh⇩0),b⟩ [→] ⟨es',(h⇩1,l⇩1,sh⇩1),b'⟩ ⟹ dom l⇩0 ⊆ dom l⇩1"
by(induct rule: red_reds_inducts)(auto simp del:fun_upd_apply)
lemma red_lcl_add: "P ⊢ ⟨e,(h,l,sh),b⟩ → ⟨e',(h',l',sh'),b'⟩ ⟹ (⋀l⇩0. P ⊢ ⟨e,(h,l⇩0++l,sh),b⟩ → ⟨e',(h',l⇩0++l',sh'),b'⟩)"
and reds_lcl_add: "P ⊢ ⟨es,(h,l,sh),b⟩ [→] ⟨es',(h',l',sh'),b'⟩ ⟹ (⋀l⇩0. P ⊢ ⟨es,(h,l⇩0++l,sh),b⟩ [→] ⟨es',(h',l⇩0++l',sh'),b'⟩)"
proof (induct rule:red_reds_inducts)
case RedCast thus ?case by(fastforce intro:red_reds.intros)
next
case RedCastFail thus ?case by(force intro:red_reds.intros)
next
case RedFAcc thus ?case by(fastforce intro:red_reds.intros)
next
case RedCall thus ?case by(fastforce intro:red_reds.intros)
next
case (InitBlockRed e h l V v sh b e' h' l' sh' b' v' T l⇩0)
have IH: "⋀l⇩0. P ⊢ ⟨e,(h, l⇩0 ++ l(V ↦ v), sh),b⟩ → ⟨e',(h', l⇩0 ++ l', sh'),b'⟩"
and l'V: "l' V = Some v'" by fact+
from IH have IH': "P ⊢ ⟨e,(h, (l⇩0 ++ l)(V ↦ v), sh),b⟩ → ⟨e',(h', l⇩0 ++ l', sh'),b'⟩"
by simp
have "(l⇩0 ++ l')(V := (l⇩0 ++ l) V) = l⇩0 ++ l'(V := l V)"
by(rule ext)(simp add:map_add_def)
with red_reds.InitBlockRed[OF IH'] l'V show ?case by(simp del:fun_upd_apply)
next
case (BlockRedNone e h l V sh b e' h' l' sh' b' T l⇩0)
have IH: "⋀l⇩0. P ⊢ ⟨e,(h, l⇩0 ++ l(V := None), sh),b⟩ → ⟨e',(h', l⇩0 ++ l', sh'),b'⟩"
and l'V: "l' V = None" and unass: "¬ assigned V e" by fact+
have "l⇩0(V := None) ++ l(V := None) = (l⇩0 ++ l)(V := None)"
by(simp add:fun_eq_iff map_add_def)
hence IH': "P ⊢ ⟨e,(h, (l⇩0++l)(V := None), sh),b⟩ → ⟨e',(h', l⇩0(V := None) ++ l', sh'),b'⟩"
using IH[of "l⇩0(V := None)"] by simp
have "(l⇩0(V := None) ++ l')(V := (l⇩0 ++ l) V) = l⇩0 ++ l'(V := l V)"
by(simp add:fun_eq_iff map_add_def)
with red_reds.BlockRedNone[OF IH' _ unass] l'V show ?case
by(simp add: map_add_def)
next
case (BlockRedSome e h l V sh b e' h' l' sh' b' v T l⇩0)
have IH: "⋀l⇩0. P ⊢ ⟨e,(h, l⇩0 ++ l(V := None), sh),b⟩ → ⟨e',(h', l⇩0 ++ l', sh'),b'⟩"
and l'V: "l' V = Some v" and unass: "¬ assigned V e" by fact+
have "l⇩0(V := None) ++ l(V := None) = (l⇩0 ++ l)(V := None)"
by(simp add:fun_eq_iff map_add_def)
hence IH': "P ⊢ ⟨e,(h, (l⇩0++l)(V := None), sh),b⟩ → ⟨e',(h', l⇩0(V := None) ++ l', sh'),b'⟩"
using IH[of "l⇩0(V := None)"] by simp
have "(l⇩0(V := None) ++ l')(V := (l⇩0 ++ l) V) = l⇩0 ++ l'(V := l V)"
by(simp add:fun_eq_iff map_add_def)
with red_reds.BlockRedSome[OF IH' _ unass] l'V show ?case
by(simp add:map_add_def)
next
case RedTryCatch thus ?case by(fastforce intro:red_reds.intros)
next
case RedTryFail thus ?case by(force intro!:red_reds.intros)
qed (simp_all add:red_reds.intros)
lemma Red_lcl_add:
assumes "P ⊢ ⟨e,(h,l,sh), b⟩ →* ⟨e',(h',l',sh'), b'⟩" shows "P ⊢ ⟨e,(h,l⇩0++l,sh),b⟩ →* ⟨e',(h',l⇩0++l',sh'),b'⟩"
using assms
proof(induct rule:converse_rtrancl_induct_red)
case 1 thus ?case by simp
next
case 2 thus ?case
by (blast dest: red_lcl_add intro: converse_rtrancl_into_rtrancl)
qed
lemma assumes wf: "wwf_J_prog P"
shows red_proc_pres: "P ⊢ ⟨e,(h,l,sh),b⟩ → ⟨e',(h',l',sh'),b'⟩
⟹ not_init C e ⟹ sh C = ⌊(sfs, Processing)⌋ ⟹ not_init C e' ∧ (∃sfs'. sh' C = ⌊(sfs', Processing)⌋)"
and reds_proc_pres: "P ⊢ ⟨es,(h,l,sh),b⟩ [→] ⟨es',(h',l',sh'),b'⟩
⟹ not_inits C es ⟹ sh C = ⌊(sfs, Processing)⌋ ⟹ not_inits C es' ∧ (∃sfs'. sh' C = ⌊(sfs', Processing)⌋)"
proof(induct rule:red_reds_inducts)
case RedCall then show ?case
using sees_wwf_nsub_RI[OF wf RedCall.hyps(2)] sub_RI_blocks_body nsub_RI_not_init by auto
next
case RedSCall then show ?case
using sees_wwf_nsub_RI[OF wf RedSCall.hyps(1)] sub_RI_blocks_body nsub_RI_not_init by auto
next
case (RedInitDone sh C sfs C' Cs e h l b)
then show ?case by(cases Cs, auto)
next
case (RedInitProcessing sh C sfs C' Cs e h l b)
then show ?case by(cases Cs, auto)
next
case (RedRInit sh C sfs i sh' C' Cs v e h l b)
then show ?case by(cases Cs, auto)
next
case (CallThrowParams es vs e es' v M h l sh b)
then show ?case by(auto dest: not_inits_def')
next
case (SCallThrowParams es vs e es' C M h l sh b)
then show ?case by(auto dest: not_inits_def')
qed(auto)
end
Theory EConform
section ‹ Expression conformance properties ›
theory EConform
imports SmallStep BigStep
begin
lemma cons_to_append: "list ≠ [] ⟶ (∃ls. a # list = ls @ [last list])"
by (metis append_butlast_last_id last_ConsR list.simps(3))
subsection "Initialization conformance"
fun init_class :: "'m prog ⇒ 'a exp ⇒ cname option" where
"init_class P (new C) = Some C" |
"init_class P (C∙⇩sF{D}) = Some D" |
"init_class P (C∙⇩sF{D}:=e⇩2) = Some D" |
"init_class P (C∙⇩sM(es)) = seeing_class P C M" |
"init_class _ _ = None"
lemma icheck_init_class: "icheck P C e ⟹ init_class P e = ⌊C⌋"
apply(induct e, auto) apply(rename_tac x1 x2 x3 x4)
apply(case_tac x4, auto)
done
fun ss_exp :: "'a exp ⇒ 'a exp" and ss_exps :: "'a exp list ⇒ 'a exp option" where
"ss_exp (new C) = new C"
| "ss_exp (Cast C e) = (case val_of e of Some v ⇒ Cast C e | _ ⇒ ss_exp e)"
| "ss_exp (Val v) = Val v"
| "ss_exp (e⇩1 «bop» e⇩2) = (case val_of e⇩1 of Some v ⇒ (case val_of e⇩2 of Some v ⇒ e⇩1 «bop» e⇩2 | _ ⇒ ss_exp e⇩2)
| _ ⇒ ss_exp e⇩1)"
| "ss_exp (Var V) = Var V"
| "ss_exp (LAss V e) = (case val_of e of Some v ⇒ LAss V e | _ ⇒ ss_exp e)"
| "ss_exp (e∙F{D}) = (case val_of e of Some v ⇒ e∙F{D} | _ ⇒ ss_exp e)"
| "ss_exp (C∙⇩sF{D}) = C∙⇩sF{D}"
| "ss_exp (e⇩1∙F{D}:=e⇩2) = (case val_of e⇩1 of Some v ⇒ (case val_of e⇩2 of Some v ⇒ e⇩1∙F{D}:=e⇩2 | _ ⇒ ss_exp e⇩2)
| _ ⇒ ss_exp e⇩1)"
| "ss_exp (C∙⇩sF{D}:=e⇩2) = (case val_of e⇩2 of Some v ⇒ C∙⇩sF{D}:=e⇩2 | _ ⇒ ss_exp e⇩2)"
| "ss_exp (e∙M(es)) = (case val_of e of Some v ⇒ (case map_vals_of es of Some t ⇒ e∙M(es) | _ ⇒ the(ss_exps es))
| _ ⇒ ss_exp e)"
| "ss_exp (C∙⇩sM(es)) = (case map_vals_of es of Some t ⇒ C∙⇩sM(es) | _ ⇒ the(ss_exps es))"
| "ss_exp ({V:T; e}) = ss_exp e"
| "ss_exp (e⇩1;;e⇩2) = (case val_of e⇩1 of Some v ⇒ ss_exp e⇩2
| None ⇒ (case lass_val_of e⇩1 of Some p ⇒ ss_exp e⇩2
| None ⇒ ss_exp e⇩1))"
| "ss_exp (if (b) e⇩1 else e⇩2) = (case bool_of b of Some True ⇒ if (b) e⇩1 else e⇩2
| Some False ⇒ if (b) e⇩1 else e⇩2
| _ ⇒ ss_exp b)"
| "ss_exp (while (b) e) = while (b) e"
| "ss_exp (throw e) = (case val_of e of Some v ⇒ throw e | _ ⇒ ss_exp e)"
| "ss_exp (try e⇩1 catch(C V) e⇩2) = (case val_of e⇩1 of Some v ⇒ try e⇩1 catch(C V) e⇩2
| _ ⇒ ss_exp e⇩1)"
| "ss_exp (INIT C (Cs,b) ← e) = INIT C (Cs,b) ← e"
| "ss_exp (RI (C,e);Cs ← e') = (case val_of e of Some v ⇒ RI (C,e);Cs ← e | _ ⇒ ss_exp e)"
| "ss_exps([]) = None"
| "ss_exps(e#es) = (case val_of e of Some v ⇒ ss_exps es | _ ⇒ Some (ss_exp e))"
lemmas ss_exp_ss_exps_induct = ss_exp_ss_exps.induct
[ case_names New Cast Val BinOp Var LAss FAcc SFAcc FAss SFAss Call SCall
Block Seq Cond While Throw Try Init RI Nil Cons ]
lemma icheck_ss_exp:
assumes "icheck P C e" shows "ss_exp e = e"
using assms
proof(cases e)
case (SFAss C F D e) then show ?thesis using assms
proof(cases e)qed(auto)
qed(auto)
lemma ss_exps_Vals_None[simp]:
"ss_exps (map Val vs) = None"
by(induct vs, auto)
lemma ss_exps_Vals_NoneI:
"ss_exps es = None ⟹ ∃vs. es = map Val vs"
using val_of_spec by(induct es, auto)
lemma ss_exps_throw_nVal:
"⟦ val_of e = None; ss_exps (map Val vs @ throw e # es') = ⌊e'⌋ ⟧
⟹ e' = ss_exp e"
by(induct vs, auto)
lemma ss_exps_throw_Val:
"⟦ val_of e = ⌊a⌋; ss_exps (map Val vs @ throw e # es') = ⌊e'⌋ ⟧
⟹ e' = throw e"
by(induct vs, auto)
abbreviation curr_init :: "'m prog ⇒ 'a exp ⇒ cname option" where
"curr_init P e ≡ init_class P (ss_exp e)"
abbreviation curr_inits :: "'m prog ⇒ 'a exp list ⇒ cname option" where
"curr_inits P es ≡ case ss_exps es of Some e ⇒ init_class P e | _ ⇒ None"
lemma icheck_curr_init': "⋀e'. ss_exp e = e' ⟹ icheck P C e' ⟹ curr_init P e = ⌊C⌋"
and icheck_curr_inits': "⋀e. ss_exps es = ⌊e⌋ ⟹ icheck P C e ⟹ curr_inits P es = ⌊C⌋"
proof(induct rule: ss_exp_ss_exps_induct)
qed(simp_all add: icheck_init_class)
lemma icheck_curr_init: "icheck P C e' ⟹ ss_exp e = e' ⟹ curr_init P e = ⌊C⌋"
by(rule icheck_curr_init')
lemma icheck_curr_inits: "icheck P C e ⟹ ss_exps es = ⌊e⌋ ⟹ curr_inits P es = ⌊C⌋"
by(rule icheck_curr_inits')
definition initPD :: "sheap ⇒ cname ⇒ bool" where
"initPD sh C ≡ ∃sfs i. sh C = Some (sfs, i) ∧ (i = Done ∨ i = Processing)"
fun iconf :: "sheap ⇒ 'a exp ⇒ bool" and iconfs :: " sheap ⇒ 'a exp list ⇒ bool" where
"iconf sh (new C) = True"
| "iconf sh (Cast C e) = iconf sh e"
| "iconf sh (Val v) = True"
| "iconf sh (e⇩1 «bop» e⇩2) = (case val_of e⇩1 of Some v ⇒ iconf sh e⇩2 | _ ⇒ iconf sh e⇩1 ∧ ¬sub_RI e⇩2)"
| "iconf sh (Var V) = True"
| "iconf sh (LAss V e) = iconf sh e"
| "iconf sh (e∙F{D}) = iconf sh e"
| "iconf sh (C∙⇩sF{D}) = True"
| "iconf sh (e⇩1∙F{D}:=e⇩2) = (case val_of e⇩1 of Some v ⇒ iconf sh e⇩2 | _ ⇒ iconf sh e⇩1 ∧ ¬sub_RI e⇩2)"
| "iconf sh (C∙⇩sF{D}:=e⇩2) = iconf sh e⇩2"
| "iconf sh (e∙M(es)) = (case val_of e of Some v ⇒ iconfs sh es | _ ⇒ iconf sh e ∧ ¬sub_RIs es)"
| "iconf sh (C∙⇩sM(es)) = iconfs sh es"
| "iconf sh ({V:T; e}) = iconf sh e"
| "iconf sh (e⇩1;;e⇩2) = (case val_of e⇩1 of Some v ⇒ iconf sh e⇩2
| None ⇒ (case lass_val_of e⇩1 of Some p ⇒ iconf sh e⇩2
| None ⇒ iconf sh e⇩1 ∧ ¬sub_RI e⇩2))"
| "iconf sh (if (b) e⇩1 else e⇩2) = (iconf sh b ∧ ¬sub_RI e⇩1 ∧ ¬sub_RI e⇩2)"
| "iconf sh (while (b) e) = (¬sub_RI b ∧ ¬sub_RI e)"
| "iconf sh (throw e) = iconf sh e"
| "iconf sh (try e⇩1 catch(C V) e⇩2) = (iconf sh e⇩1 ∧ ¬sub_RI e⇩2)"
| "iconf sh (INIT C (Cs,b) ← e) = ((case Cs of Nil ⇒ initPD sh C | C'#Cs' ⇒ last Cs = C) ∧ ¬sub_RI e)"
| "iconf sh (RI (C,e);Cs ← e') = (iconf sh e ∧ ¬sub_RI e')"
| "iconfs sh ([]) = True"
| "iconfs sh (e#es) = (case val_of e of Some v ⇒ iconfs sh es | _ ⇒ iconf sh e ∧ ¬sub_RIs es)"
lemma iconfs_map_throw: "iconfs sh (map Val vs @ throw e # es') ⟹ iconf sh e"
by(induct vs,auto)
lemma nsub_RI_iconf_aux:
"(¬sub_RI (e::'a exp) ⟶ (∀e'. e' ∈ subexp e ⟶ ¬sub_RI e' ⟶ iconf sh e') ⟶ iconf sh e)
∧ (¬sub_RIs (es::'a exp list) ⟶ (∀e'. e' ∈ subexps es ⟶ ¬sub_RI e' ⟶ iconf sh e') ⟶ iconfs sh es)"
proof(induct rule: sub_RI_sub_RIs.induct) qed(auto)
lemma nsub_RI_iconf_aux':
"(⋀e'. subexp_of e' e ⟹ ¬sub_RI e' ⟶ iconf sh e') ⟹ (¬sub_RI e ⟹ iconf sh e)"
by(simp add: nsub_RI_iconf_aux)
lemma nsub_RI_iconf: "¬sub_RI e ⟹ iconf sh e"
apply(cut_tac e = e and R = "λe. ¬sub_RI e ⟶ iconf sh e" in subexp_induct)
apply(rename_tac ea) apply(case_tac ea, simp_all)
apply(clarsimp simp: nsub_RI_iconf_aux)
done
lemma nsub_RIs_iconfs: "¬sub_RIs es ⟹ iconfs sh es"
apply(cut_tac es = es and R = "λe. ¬sub_RI e ⟶ iconf sh e"
and Rs = "λes. ¬sub_RIs es ⟶ iconfs sh es" in subexps_induct)
apply(rename_tac esa) apply(case_tac esa, simp_all)
apply(clarsimp simp: nsub_RI_iconf_aux)+
done
lemma lass_val_of_iconf: "lass_val_of e = ⌊a⌋ ⟹ iconf sh e"
by(drule lass_val_of_nsub_RI, erule nsub_RI_iconf)
lemma icheck_iconf:
assumes "icheck P C e" shows "iconf sh e"
using assms
proof(cases e)
case (SFAss C F D e) then show ?thesis using assms
proof(cases e)qed(auto)
next
case (SCall C M es) then show ?thesis using assms
by (auto simp: nsub_RIs_iconfs)
next
qed(auto)
subsection "Indicator boolean conformance"
definition bconf :: "'m prog ⇒ sheap ⇒ 'a exp ⇒ bool ⇒ bool" ("_,_ ⊢⇩b '(_,_') √" [51,51,0,0] 50)
where
"P,sh ⊢⇩b (e,b) √ ≡ b ⟶ (∃C. icheck P C (ss_exp e) ∧ initPD sh C)"
definition bconfs :: "'m prog ⇒ sheap ⇒ 'a exp list ⇒ bool ⇒ bool" ("_,_ ⊢⇩b '(_,_') √" [51,51,0,0] 50)
where
"P,sh ⊢⇩b (es,b) √ ≡ b ⟶ (∃C. (icheck P C (the(ss_exps es))
∧ (curr_inits P es = Some C) ∧ initPD sh C))"
lemma bconf_nonVal[simp]:
"P,sh ⊢⇩b (e,True) √ ⟹ val_of e = None"
by(cases e, auto simp: bconf_def)
lemma bconfs_nonVals[simp]:
"P,sh ⊢⇩b (es,True) √ ⟹ map_vals_of es = None"
by(induct es, auto simp: bconfs_def)
lemma bconf_Cast[iff]:
"P,sh ⊢⇩b (Cast C e,b) √ ⟷ P,sh ⊢⇩b (e,b) √"
apply(unfold bconf_def, cases b, auto)
apply(drule val_of_spec, simp)
done
lemma bconf_BinOp[iff]:
"P,sh ⊢⇩b (e1 «bop» e2,b) √
⟷ (case val_of e1 of Some v ⇒ P,sh ⊢⇩b (e2,b) √ | _ ⇒ P,sh ⊢⇩b (e1,b) √)"
apply(unfold bconf_def, cases b, auto)
apply(drule val_of_spec, simp)
done
lemma bconf_LAss[iff]:
"P,sh ⊢⇩b (LAss V e,b) √ ⟷ P,sh ⊢⇩b (e,b) √"
apply(unfold bconf_def, cases b, auto)
apply(drule val_of_spec, simp)
done
lemma bconf_FAcc[iff]:
"P,sh ⊢⇩b (e∙F{D},b) √ ⟷ P,sh ⊢⇩b (e,b) √"
apply(unfold bconf_def, cases b, auto)
apply(drule val_of_spec, simp)
done
lemma bconf_FAss[iff]:
"P,sh ⊢⇩b (FAss e1 F D e2,b) √
⟷ (case val_of e1 of Some v ⇒ P,sh ⊢⇩b (e2,b) √ | _ ⇒ P,sh ⊢⇩b (e1,b) √)"
apply(unfold bconf_def, cases b, auto)
apply(drule val_of_spec, simp)
done
lemma bconf_SFAss[iff]:
"val_of e2 = None ⟹ P,sh ⊢⇩b (SFAss C F D e2,b) √ ⟷ P,sh ⊢⇩b (e2,b) √"
by(unfold bconf_def, cases b, auto)
lemma bconfs_Vals[iff]:
"P,sh ⊢⇩b (map Val vs, b) √ ⟷ ¬ b"
by(unfold bconfs_def, simp)
lemma bconf_Call[iff]:
"P,sh ⊢⇩b (e∙M(es),b) √
⟷ (case val_of e of Some v ⇒ P,sh ⊢⇩b (es,b) √ | _ ⇒ P,sh ⊢⇩b (e,b) √)"
proof(cases b)
case True
then show ?thesis
proof(cases "ss_exps es")
case None
then obtain vs where "es = map Val vs" using ss_exps_Vals_NoneI by auto
then have mv: "map_vals_of es = ⌊vs⌋" by simp
then show ?thesis by(auto simp: bconf_def) (simp add: bconfs_def)
next
case (Some a)
then show ?thesis by(auto simp: bconf_def, auto simp: bconfs_def icheck_init_class)
qed
qed(simp add: bconf_def bconfs_def)
lemma bconf_SCall[iff]:
assumes mvn: "map_vals_of es = None"
shows "P,sh ⊢⇩b (C∙⇩sM(es),b) √ ⟷ P,sh ⊢⇩b (es,b) √"
proof(cases b)
case True
then show ?thesis
proof(cases "ss_exps es")
case None
then have "∃vs. es = map Val vs" using ss_exps_Vals_NoneI by auto
then show ?thesis using mvn finals_def by clarsimp
next
case (Some a)
then show ?thesis by(auto simp: bconf_def, auto simp: bconfs_def icheck_init_class)
qed
qed(simp add: bconf_def bconfs_def)
lemma bconf_Cons[iff]:
"P,sh ⊢⇩b (e#es,b) √
⟷ (case val_of e of Some v ⇒ P,sh ⊢⇩b (es,b) √ | _ ⇒ P,sh ⊢⇩b (e,b) √)"
proof(cases b)
case True
then show ?thesis
proof(cases "ss_exps es")
case None
then have "∃vs. es = map Val vs" using ss_exps_Vals_NoneI by auto
then show ?thesis using None by(auto simp: bconf_def bconfs_def icheck_init_class)
next
case (Some a)
then show ?thesis by(auto simp: bconf_def bconfs_def icheck_init_class)
qed
qed(simp add: bconf_def bconfs_def)
lemma bconf_InitBlock[iff]:
"P,sh ⊢⇩b ({V:T; V:=Val v;; e⇩2},b) √ ⟷ P,sh ⊢⇩b (e⇩2,b) √"
by(unfold bconf_def, cases b, auto simp: assigned_def)
lemma bconf_Block[iff]:
"P,sh ⊢⇩b ({V:T; e},b) √ ⟷ P,sh ⊢⇩b (e,b) √"
by(unfold bconf_def, cases b, auto)
lemma bconf_Seq[iff]:
"P,sh ⊢⇩b (e1;;e2,b) √
⟷ (case val_of e1 of Some v ⇒ P,sh ⊢⇩b (e2,b) √
| _ ⇒ (case lass_val_of e1 of Some p ⇒ P,sh ⊢⇩b (e2,b) √
| None ⇒ P,sh ⊢⇩b (e1,b) √))"
by(unfold bconf_def, cases b, auto dest: val_of_spec lass_val_of_spec)
lemma bconf_Cond[iff]:
"P,sh ⊢⇩b (if (b) e⇩1 else e⇩2,b') √ ⟷ P,sh ⊢⇩b (b,b') √"
apply(unfold bconf_def, cases "bool_of b") apply auto[1]
apply(rename_tac a) apply(case_tac a)
apply(simp, drule bool_of_specT) apply auto[1]
apply(simp, drule bool_of_specF) apply auto[1]
done
lemma bconf_While[iff]:
"P,sh ⊢⇩b (while (b) e,b') √ ⟷ ¬b'"
by(unfold bconf_def, cases b, auto)
lemma bconf_Throw[iff]:
"P,sh ⊢⇩b (throw e,b) √ ⟷ P,sh ⊢⇩b (e,b) √"
apply(unfold bconf_def, cases b, auto)
apply(drule val_of_spec, simp)
done
lemma bconf_Try[iff]:
"P,sh ⊢⇩b (try e⇩1 catch(C V) e⇩2,b) √ ⟷ P,sh ⊢⇩b (e⇩1,b) √"
apply(unfold bconf_def, cases b, auto)
apply(drule val_of_spec, simp)
done
lemma bconf_INIT[iff]:
"P,sh ⊢⇩b (INIT C (Cs,b') ← e,b) √ ⟷ ¬b"
by(unfold bconf_def, cases b, auto)
lemma bconf_RI[iff]:
"P,sh ⊢⇩b (RI(C,e);Cs ← e',b) √ ⟷ P,sh ⊢⇩b (e,b) √"
apply(unfold bconf_def, cases b, auto)
apply(drule val_of_spec, simp)
done
lemma bconfs_map_throw[iff]:
"P,sh ⊢⇩b (map Val vs @ throw e # es',b) √ ⟷ P,sh ⊢⇩b (e,b) √"
by(induct vs, auto)
end
Theory Progress
section ‹ Progress of Small Step Semantics ›
theory Progress
imports WellTypeRT DefAss "../Common/Conform" EConform
begin
lemma final_addrE:
"⟦ P,E,h,sh ⊢ e : Class C; final e;
⋀a. e = addr a ⟹ R;
⋀a. e = Throw a ⟹ R ⟧ ⟹ R"
by(auto simp:final_def)
lemma finalRefE:
"⟦ P,E,h,sh ⊢ e : T; is_refT T; final e;
e = null ⟹ R;
⋀a C. ⟦ e = addr a; T = Class C ⟧ ⟹ R;
⋀a. e = Throw a ⟹ R ⟧ ⟹ R"
by(auto simp:final_def is_refT_def)
text‹ Derivation of new induction scheme for well typing: ›
inductive
WTrt' :: "[J_prog,heap,sheap,env,expr,ty] ⇒ bool"
and WTrts' :: "[J_prog,heap,sheap,env,expr list, ty list] ⇒ bool"
and WTrt2' :: "[J_prog,env,heap,sheap,expr,ty] ⇒ bool"
("_,_,_,_ ⊢ _ :'' _" [51,51,51,51]50)
and WTrts2' :: "[J_prog,env,heap,sheap,expr list, ty list] ⇒ bool"
("_,_,_,_ ⊢ _ [:''] _" [51,51,51,51]50)
for P :: J_prog and h :: heap and sh :: sheap
where
"P,E,h,sh ⊢ e :' T ≡ WTrt' P h sh E e T"
| "P,E,h,sh ⊢ es [:'] Ts ≡ WTrts' P h sh E es Ts"
| "is_class P C ⟹ P,E,h,sh ⊢ new C :' Class C"
| "⟦ P,E,h,sh ⊢ e :' T; is_refT T; is_class P C ⟧
⟹ P,E,h,sh ⊢ Cast C e :' Class C"
| "typeof⇘h⇙ v = Some T ⟹ P,E,h,sh ⊢ Val v :' T"
| "E v = Some T ⟹ P,E,h,sh ⊢ Var v :' T"
| "⟦ P,E,h,sh ⊢ e⇩1 :' T⇩1; P,E,h,sh ⊢ e⇩2 :' T⇩2 ⟧
⟹ P,E,h,sh ⊢ e⇩1 «Eq» e⇩2 :' Boolean"
| "⟦ P,E,h,sh ⊢ e⇩1 :' Integer; P,E,h,sh ⊢ e⇩2 :' Integer ⟧
⟹ P,E,h,sh ⊢ e⇩1 «Add» e⇩2 :' Integer"
| "⟦ P,E,h,sh ⊢ Var V :' T; P,E,h,sh ⊢ e :' T'; P ⊢ T' ≤ T ⟧
⟹ P,E,h,sh ⊢ V:=e :' Void"
| "⟦ P,E,h,sh ⊢ e :' Class C; P ⊢ C has F,NonStatic:T in D ⟧ ⟹ P,E,h,sh ⊢ e∙F{D} :' T"
| "P,E,h,sh ⊢ e :' NT ⟹ P,E,h,sh ⊢ e∙F{D} :' T"
| "⟦ P ⊢ C has F,Static:T in D ⟧ ⟹ P,E,h,sh ⊢ C∙⇩sF{D} :' T"
| "⟦ P,E,h,sh ⊢ e⇩1 :' Class C; P ⊢ C has F,NonStatic:T in D;
P,E,h,sh ⊢ e⇩2 :' T⇩2; P ⊢ T⇩2 ≤ T ⟧
⟹ P,E,h,sh ⊢ e⇩1∙F{D}:=e⇩2 :' Void"
| "⟦ P,E,h,sh ⊢ e⇩1:'NT; P,E,h,sh ⊢ e⇩2 :' T⇩2 ⟧ ⟹ P,E,h,sh ⊢ e⇩1∙F{D}:=e⇩2 :' Void"
| "⟦ P ⊢ C has F,Static:T in D;
P,E,h,sh ⊢ e⇩2 :' T⇩2; P ⊢ T⇩2 ≤ T ⟧
⟹ P,E,h,sh ⊢ C∙⇩sF{D}:=e⇩2 :' Void"
| "⟦ P,E,h,sh ⊢ e :' Class C; P ⊢ C sees M,NonStatic:Ts → T = (pns,body) in D;
P,E,h,sh ⊢ es [:'] Ts'; P ⊢ Ts' [≤] Ts ⟧
⟹ P,E,h,sh ⊢ e∙M(es) :' T"
| "⟦ P,E,h,sh ⊢ e :' NT; P,E,h,sh ⊢ es [:'] Ts ⟧ ⟹ P,E,h,sh ⊢ e∙M(es) :' T"
| "⟦ P ⊢ C sees M,Static:Ts → T = (pns,body) in D;
P,E,h,sh ⊢ es [:'] Ts'; P ⊢ Ts' [≤] Ts;
M = clinit ⟶ sh D = ⌊(sfs,Processing)⌋ ∧ es = map Val vs ⟧
⟹ P,E,h,sh ⊢ C∙⇩sM(es) :' T"
| "P,E,h,sh ⊢ [] [:'] []"
| "⟦ P,E,h,sh ⊢ e :' T; P,E,h,sh ⊢ es [:'] Ts ⟧ ⟹ P,E,h,sh ⊢ e#es [:'] T#Ts"
| "⟦ typeof⇘h⇙ v = Some T⇩1; P ⊢ T⇩1 ≤ T; P,E(V↦T),h,sh ⊢ e⇩2 :' T⇩2 ⟧
⟹ P,E,h,sh ⊢ {V:T := Val v; e⇩2} :' T⇩2"
| "⟦ P,E(V↦T),h,sh ⊢ e :' T'; ¬ assigned V e ⟧ ⟹ P,E,h,sh ⊢ {V:T; e} :' T'"
| "⟦ P,E,h,sh ⊢ e⇩1:' T⇩1; P,E,h,sh ⊢ e⇩2:'T⇩2 ⟧ ⟹ P,E,h,sh ⊢ e⇩1;;e⇩2 :' T⇩2"
| "⟦ P,E,h,sh ⊢ e :' Boolean; P,E,h,sh ⊢ e⇩1:' T⇩1; P,E,h,sh ⊢ e⇩2:' T⇩2;
P ⊢ T⇩1 ≤ T⇩2 ∨ P ⊢ T⇩2 ≤ T⇩1;
P ⊢ T⇩1 ≤ T⇩2 ⟶ T = T⇩2; P ⊢ T⇩2 ≤ T⇩1 ⟶ T = T⇩1 ⟧
⟹ P,E,h,sh ⊢ if (e) e⇩1 else e⇩2 :' T"
| "⟦ P,E,h,sh ⊢ e :' Boolean; P,E,h,sh ⊢ c:' T ⟧
⟹ P,E,h,sh ⊢ while(e) c :' Void"
| "⟦ P,E,h,sh ⊢ e :' T⇩r; is_refT T⇩r ⟧ ⟹ P,E,h,sh ⊢ throw e :' T"
| "⟦ P,E,h,sh ⊢ e⇩1 :' T⇩1; P,E(V ↦ Class C),h,sh ⊢ e⇩2 :' T⇩2; P ⊢ T⇩1 ≤ T⇩2 ⟧
⟹ P,E,h,sh ⊢ try e⇩1 catch(C V) e⇩2 :' T⇩2"
| "⟦ P,E,h,sh ⊢ e :' T; ∀C' ∈ set (C#Cs). is_class P C'; ¬sub_RI e;
∀C' ∈ set (tl Cs). ∃sfs. sh C' = ⌊(sfs,Processing)⌋;
b ⟶ (∀C' ∈ set Cs. ∃sfs. sh C' = ⌊(sfs,Processing)⌋);
distinct Cs; supercls_lst P Cs ⟧ ⟹ P,E,h,sh ⊢ INIT C (Cs, b) ← e :' T"
| "⟦ P,E,h,sh ⊢ e :' T; P,E,h,sh ⊢ e' :' T'; ∀C' ∈ set (C#Cs). is_class P C'; ¬sub_RI e';
∀C' ∈ set (C#Cs). not_init C' e;
∀C' ∈ set Cs. ∃sfs. sh C' = ⌊(sfs,Processing)⌋;
∃sfs. sh C = ⌊(sfs, Processing)⌋ ∨ (sh C = ⌊(sfs, Error)⌋ ∧ e = THROW NoClassDefFoundError);
distinct (C#Cs); supercls_lst P (C#Cs) ⟧
⟹ P,E,h,sh ⊢ RI(C, e);Cs ← e' :' T'"
lemmas WTrt'_induct = WTrt'_WTrts'.induct [split_format (complete)]
and WTrt'_inducts = WTrt'_WTrts'.inducts [split_format (complete)]
inductive_cases WTrt'_elim_cases[elim!]:
"P,E,h,sh ⊢ V :=e :' T"
lemma [iff]: "P,E,h,sh ⊢ e⇩1;;e⇩2 :' T⇩2 = (∃T⇩1. P,E,h,sh ⊢ e⇩1:' T⇩1 ∧ P,E,h,sh ⊢ e⇩2:' T⇩2)"
apply(rule iffI)
apply (auto elim: WTrt'.cases intro!:WTrt'_WTrts'.intros)
done
lemma [iff]: "P,E,h,sh ⊢ Val v :' T = (typeof⇘h⇙ v = Some T)"
apply(rule iffI)
apply (auto elim: WTrt'.cases intro!:WTrt'_WTrts'.intros)
done
lemma [iff]: "P,E,h,sh ⊢ Var v :' T = (E v = Some T)"
apply(rule iffI)
apply (auto elim: WTrt'.cases intro!:WTrt'_WTrts'.intros)
done
lemma wt_wt': "P,E,h,sh ⊢ e : T ⟹ P,E,h,sh ⊢ e :' T"
and wts_wts': "P,E,h,sh ⊢ es [:] Ts ⟹ P,E,h,sh ⊢ es [:'] Ts"
apply (induct rule:WTrt_inducts)
prefer 17
apply(case_tac "assigned V e")
apply(clarsimp simp add:fun_upd_same assigned_def simp del:fun_upd_apply)
apply(erule (2) WTrt'_WTrts'.intros)
apply(erule (1) WTrt'_WTrts'.intros)
apply(blast intro:WTrt'_WTrts'.intros)+
done
lemma wt'_wt: "P,E,h,sh ⊢ e :' T ⟹ P,E,h,sh ⊢ e : T"
and wts'_wts: "P,E,h,sh ⊢ es [:'] Ts ⟹ P,E,h,sh ⊢ es [:] Ts"
apply (induct rule:WTrt'_inducts)
prefer 19
apply(rule WTrt_WTrts.intros)
apply(rule WTrt_WTrts.intros)
apply(rule WTrt_WTrts.intros)
apply simp
apply(erule (2) WTrt_WTrts.intros)
apply(blast intro:WTrt_WTrts.intros)+
done
corollary wt'_iff_wt: "(P,E,h,sh ⊢ e :' T) = (P,E,h,sh ⊢ e : T)"
by(blast intro:wt_wt' wt'_wt)
corollary wts'_iff_wts: "(P,E,h,sh ⊢ es [:'] Ts) = (P,E,h,sh ⊢ es [:] Ts)"
by(blast intro:wts_wts' wts'_wts)
lemmas WTrt_inducts2 = WTrt'_inducts [unfolded wt'_iff_wt wts'_iff_wts,
case_names WTrtNew WTrtCast WTrtVal WTrtVar WTrtBinOpEq WTrtBinOpAdd WTrtLAss
WTrtFAcc WTrtFAccNT WTrtSFAcc WTrtFAss WTrtFAssNT WTrtSFAss WTrtCall WTrtCallNT WTrtSCall
WTrtNil WTrtCons WTrtInitBlock WTrtBlock WTrtSeq WTrtCond WTrtWhile WTrtThrow WTrtTry
WTrtInit WTrtRI, consumes 1]
theorem assumes wf: "wwf_J_prog P" and hconf: "P ⊢ h √" and shconf: "P,h ⊢⇩s sh √"
shows progress: "P,E,h,sh ⊢ e : T ⟹
(⋀l. ⟦ 𝒟 e ⌊dom l⌋; P,sh ⊢⇩b (e,b) √; ¬ final e ⟧ ⟹ ∃e' s' b'. P ⊢ ⟨e,(h,l,sh),b⟩ → ⟨e',s',b'⟩)"
and "P,E,h,sh ⊢ es [:] Ts ⟹
(⋀l. ⟦ 𝒟s es ⌊dom l⌋; P,sh ⊢⇩b (es,b) √; ¬ finals es ⟧ ⟹ ∃es' s' b'. P ⊢ ⟨es,(h,l,sh),b⟩ [→] ⟨es',s',b'⟩)"
proof (induct rule:WTrt_inducts2)
case (WTrtNew C) show ?case
proof (cases b)
case True then show ?thesis
proof cases
assume "∃a. h a = None"
with assms WTrtNew True show ?thesis
by (fastforce del:exE intro!:RedNew simp add:new_Addr_def
elim!:wf_Fields_Ex[THEN exE])
next
assume "¬(∃a. h a = None)"
with assms WTrtNew True show ?thesis
by(fastforce intro:RedNewFail simp:new_Addr_def)
qed
next
case False then show ?thesis
proof cases
assume "∃sfs. sh C = Some (sfs, Done)"
with assms WTrtNew False show ?thesis
by(fastforce intro:NewInitDoneRed simp:new_Addr_def)
next
assume "∄sfs. sh C = Some (sfs, Done)"
with assms WTrtNew False show ?thesis
by(fastforce intro:NewInitRed simp:new_Addr_def)
qed
qed
next
case (WTrtCast E e T C)
have wte: "P,E,h,sh ⊢ e : T" and ref: "is_refT T"
and IH: "⋀l. ⟦𝒟 e ⌊dom l⌋; P,sh ⊢⇩b (e,b) √; ¬ final e⟧
⟹ ∃e' s' b'. P ⊢ ⟨e,(h,l,sh),b⟩ → ⟨e',s',b'⟩"
and D: "𝒟 (Cast C e) ⌊dom l⌋"
and castconf: "P,sh ⊢⇩b (Cast C e,b) √" by fact+
from D have De: "𝒟 e ⌊dom l⌋" by auto
have bconf: "P,sh ⊢⇩b (e,b) √" using castconf bconf_Cast by fast
show ?case
proof cases
assume "final e"
with wte ref show ?thesis
proof (rule finalRefE)
assume "e = null" thus ?case by(fastforce intro:RedCastNull)
next
fix D a assume A: "T = Class D" "e = addr a"
show ?thesis
proof cases
assume "P ⊢ D ≼⇧* C"
thus ?thesis using A wte by(fastforce intro:RedCast)
next
assume "¬ P ⊢ D ≼⇧* C"
thus ?thesis using A wte by(fastforce elim!:RedCastFail)
qed
next
fix a assume "e = Throw a"
thus ?thesis by(blast intro!:red_reds.CastThrow)
qed
next
assume nf: "¬ final e"
from IH[OF De bconf nf] show ?thesis by (blast intro:CastRed)
qed
next
case WTrtVal thus ?case by(simp add:final_def)
next
case WTrtVar thus ?case by(fastforce intro:RedVar simp:hyper_isin_def)
next
case (WTrtBinOpEq E e1 T1 e2 T2) show ?case
proof cases
assume "final e1"
thus ?thesis
proof (rule finalE)
fix v1 assume eV[simp]: "e1 = Val v1"
show ?thesis
proof cases
assume "final e2"
thus ?thesis
proof (rule finalE)
fix v2 assume "e2 = Val v2"
thus ?thesis using WTrtBinOpEq by(fastforce intro:RedBinOp)
next
fix a assume "e2 = Throw a"
thus ?thesis using eV by(blast intro:red_reds.BinOpThrow2)
qed
next
assume nf: "¬ final e2"
then have "P,sh ⊢⇩b (e2,b) √" using WTrtBinOpEq.prems(2) by(simp add:bconf_BinOp)
with WTrtBinOpEq nf show ?thesis
by simp (fast intro!:BinOpRed2)
qed
next
fix a assume "e1 = Throw a"
thus ?thesis by (fast intro:red_reds.BinOpThrow1)
qed
next
assume nf: "¬ final e1"
then have e1: "val_of e1 = None" proof(cases e1)qed(auto)
then have "P,sh ⊢⇩b (e1,b) √" using WTrtBinOpEq.prems(2) by(simp add:bconf_BinOp)
with WTrtBinOpEq nf e1 show ?thesis
by simp (fast intro:BinOpRed1)
qed
next
case (WTrtBinOpAdd E e1 e2) show ?case
proof cases
assume "final e1"
thus ?thesis
proof (rule finalE)
fix v1 assume eV[simp]: "e1 = Val v1"
show ?thesis
proof cases
assume "final e2"
thus ?thesis
proof (rule finalE)
fix v2 assume eV2:"e2 = Val v2"
then obtain i1 i2 where "v1 = Intg i1 ∧ v2 = Intg i2" using WTrtBinOpAdd by clarsimp
thus ?thesis using WTrtBinOpAdd eV eV2 by(fastforce intro:RedBinOp)
next
fix a assume "e2 = Throw a"
thus ?thesis using eV by(blast intro:red_reds.BinOpThrow2)
qed
next
assume nf:"¬ final e2"
then have "P,sh ⊢⇩b (e2,b) √" using WTrtBinOpAdd.prems(2) by(simp add:bconf_BinOp)
with WTrtBinOpAdd nf show ?thesis
by simp (fast intro!:BinOpRed2)
qed
next
fix a assume "e1 = Throw a"
thus ?thesis by(fast intro:red_reds.BinOpThrow1)
qed
next
assume nf: "¬ final e1"
then have e1: "val_of e1 = None" proof(cases e1)qed(auto)
then have "P,sh ⊢⇩b (e1,b) √" using WTrtBinOpAdd.prems(2) by(simp add:bconf_BinOp)
with WTrtBinOpAdd nf e1 show ?thesis
by simp (fast intro:BinOpRed1)
qed
next
case (WTrtLAss E V T e T')
then have bconf: "P,sh ⊢⇩b (e,b) √" using bconf_LAss by fast
show ?case
proof cases
assume "final e" with WTrtLAss show ?thesis
by(fastforce simp:final_def intro: red_reds.RedLAss red_reds.LAssThrow)
next
assume "¬ final e" with WTrtLAss bconf show ?thesis
by simp (fast intro:LAssRed)
qed
next
case (WTrtFAcc E e C F T D)
then have bconf: "P,sh ⊢⇩b (e,b) √" using bconf_FAcc by fast
have wte: "P,E,h,sh ⊢ e : Class C"
and field: "P ⊢ C has F,NonStatic:T in D" by fact+
show ?case
proof cases
assume "final e"
with wte show ?thesis
proof (rule final_addrE)
fix a assume e: "e = addr a"
with wte obtain fs where hp: "h a = Some(C,fs)" by auto
with hconf have "P,h ⊢ (C,fs) √" using hconf_def by fastforce
then obtain v where "fs(F,D) = Some v" using field
by(fastforce dest:has_fields_fun simp:oconf_def has_field_def)
with hp e show ?thesis by (meson field red_reds.RedFAcc)
next
fix a assume "e = Throw a"
thus ?thesis by(fastforce intro:red_reds.FAccThrow)
qed
next
assume "¬ final e" with WTrtFAcc bconf show ?thesis
by(fastforce intro!:FAccRed)
qed
next
case (WTrtFAccNT E e F D T)
then have bconf: "P,sh ⊢⇩b (e,b) √" using bconf_FAcc by fast
show ?case
proof cases
assume "final e"
with WTrtFAccNT show ?thesis
by(fastforce simp:final_def intro: red_reds.RedFAccNull red_reds.FAccThrow)
next
assume "¬ final e"
with WTrtFAccNT bconf show ?thesis by simp (fast intro:FAccRed)
qed
next
case (WTrtSFAcc C F T D E) then show ?case
proof (cases b)
case True
then obtain sfs i where shD: "sh D = ⌊(sfs,i)⌋"
using bconf_def[of P sh "C∙⇩sF{D}" b] WTrtSFAcc.prems(2) initPD_def by auto
with shconf have "P,h,D ⊢⇩s sfs √" using shconf_def[of P h sh] by auto
then obtain v where sfsF: "sfs F = Some v" using WTrtSFAcc.hyps
by(unfold soconf_def) (auto dest:has_field_idemp)
then show ?thesis using WTrtSFAcc.hyps shD sfsF True
by(fastforce elim:RedSFAcc)
next
case False
with assms WTrtSFAcc show ?thesis
by(metis (full_types) SFAccInitDoneRed SFAccInitRed)
qed
next
case (WTrtFAss E e1 C F T D e2 T2)
have wte1: "P,E,h,sh ⊢ e1 : Class C" and field: "P ⊢ C has F,NonStatic:T in D" by fact+
show ?case
proof cases
assume "final e1"
with wte1 show ?thesis
proof (rule final_addrE)
fix a assume e1: "e1 = addr a"
show ?thesis
proof cases
assume "final e2"
thus ?thesis
proof (rule finalE)
fix v assume "e2 = Val v"
thus ?thesis using e1 wte1 by(fastforce intro: RedFAss[OF field])
next
fix a assume "e2 = Throw a"
thus ?thesis using e1 by(fastforce intro:red_reds.FAssThrow2)
qed
next
assume nf: "¬ final e2"
then have "P,sh ⊢⇩b (e2,b) √" using WTrtFAss.prems(2) e1 by(simp add:bconf_FAss)
with WTrtFAss e1 nf show ?thesis
by simp (fast intro!:FAssRed2)
qed
next
fix a assume "e1 = Throw a"
thus ?thesis by(fastforce intro:red_reds.FAssThrow1)
qed
next
assume nf: "¬ final e1"
then have e1: "val_of e1 = None" proof(cases e1)qed(auto)
then have "P,sh ⊢⇩b (e1,b) √" using WTrtFAss.prems(2) by(simp add:bconf_FAss)
with WTrtFAss nf e1 show ?thesis
by simp (blast intro!:FAssRed1)
qed
next
case (WTrtFAssNT E e⇩1 e⇩2 T⇩2 F D)
show ?case
proof cases
assume e1: "final e⇩1"
show ?thesis
proof cases
assume "final e⇩2"
with WTrtFAssNT e1 show ?thesis
by(fastforce simp:final_def
intro: red_reds.RedFAssNull red_reds.FAssThrow1 red_reds.FAssThrow2)
next
assume nf: "¬ final e⇩2"
show ?thesis
proof (rule finalE[OF e1])
fix v assume ev: "e⇩1 = Val v"
then have "P,sh ⊢⇩b (e⇩2,b) √" using WTrtFAssNT.prems(2) nf by(simp add:bconf_FAss)
with WTrtFAssNT ev nf show ?thesis by auto (meson red_reds.FAssRed2)
next
fix a assume et: "e⇩1 = Throw a"
then have "P,sh ⊢⇩b (e⇩1,b) √" using WTrtFAssNT.prems(2) nf by(simp add:bconf_FAss)
with WTrtFAssNT et nf show ?thesis by(fastforce intro: red_reds.FAssThrow1)
qed
qed
next
assume nf: "¬ final e⇩1"
then have e1: "val_of e⇩1 = None" proof(cases e⇩1)qed(auto)
then have "P,sh ⊢⇩b (e⇩1,b) √" using WTrtFAssNT.prems(2) by(simp add:bconf_FAss)
with WTrtFAssNT nf e1 show ?thesis
by simp (blast intro!:FAssRed1)
qed
next
case (WTrtSFAss C F T D E e2 T⇩2)
have field: "P ⊢ C has F,Static:T in D" by fact+
show ?case
proof cases
assume "final e2"
thus ?thesis
proof (rule finalE)
fix v assume ev: "e2 = Val v"
then show ?case
proof (cases b)
case True
then obtain sfs i where shD: "sh D = ⌊(sfs,i)⌋"
using bconf_def[of P _ "C∙⇩sF{D} := e2"] WTrtSFAss.prems(2) initPD_def ev by auto
with shconf have "P,h,D ⊢⇩s sfs √" using shconf_def[of P] by auto
then obtain v where sfsF: "sfs F = Some v" using field
by(unfold soconf_def) (auto dest:has_field_idemp)
then show ?thesis using WTrtSFAss.hyps shD sfsF True ev
by(fastforce elim:RedSFAss)
next
case False
with assms WTrtSFAss ev show ?thesis
by(metis (full_types) SFAssInitDoneRed SFAssInitRed)
qed
next
fix a assume "e2 = Throw a"
thus ?thesis by(fastforce intro:red_reds.SFAssThrow)
qed
next
assume nf: "¬ final e2"
then have "val_of e2 = None" using final_def val_of_spec by fastforce
then have "P,sh ⊢⇩b (e2,b) √" using WTrtSFAss.prems(2) by(simp add:bconf_SFAss)
with WTrtSFAss nf show ?thesis
by simp (fast intro!:SFAssRed)
qed
next
case (WTrtCall E e C M Ts T pns body D es Ts')
have wte: "P,E,h,sh ⊢ e : Class C"
and "method": "P ⊢ C sees M,NonStatic:Ts→T = (pns,body) in D"
and wtes: "P,E,h,sh ⊢ es [:] Ts'"and sub: "P ⊢ Ts' [≤] Ts"
and IHes: "⋀l.
⟦𝒟s es ⌊dom l⌋; P,sh ⊢⇩b (es,b) √; ¬ finals es⟧
⟹ ∃es' s' b'. P ⊢ ⟨es,(h,l,sh),b⟩ [→] ⟨es',s',b'⟩"
and D: "𝒟 (e∙M(es)) ⌊dom l⌋" by fact+
show ?case
proof cases
assume "final e"
with wte show ?thesis
proof (rule final_addrE)
fix a assume e_addr: "e = addr a"
show ?thesis
proof cases
assume es: "∃vs. es = map Val vs"
from wte e_addr obtain fs where ha: "h a = Some(C,fs)" by auto
show ?thesis
using e_addr ha "method" WTrts_same_length[OF wtes] sub es sees_wf_mdecl[OF wf "method"]
by(fastforce intro!: RedCall simp:list_all2_iff wf_mdecl_def)
next
assume "¬(∃vs. es = map Val vs)"
hence not_all_Val: "¬(∀e ∈ set es. ∃v. e = Val v)"
by(simp add:ex_map_conv)
let ?ves = "takeWhile (λe. ∃v. e = Val v) es"
let ?rest = "dropWhile (λe. ∃v. e = Val v) es"
let ?ex = "hd ?rest" let ?rst = "tl ?rest"
from not_all_Val have nonempty: "?rest ≠ []" by auto
hence es: "es = ?ves @ ?ex # ?rst" by simp
have "∀e ∈ set ?ves. ∃v. e = Val v" by(fastforce dest:set_takeWhileD)
then obtain vs where ves: "?ves = map Val vs"
using ex_map_conv by blast
show ?thesis
proof cases
assume "final ?ex"
moreover from nonempty have "¬(∃v. ?ex = Val v)"
by(auto simp:neq_Nil_conv simp del:dropWhile_eq_Nil_conv)
(simp add:dropWhile_eq_Cons_conv)
ultimately obtain b where ex_Throw: "?ex = Throw b"
by(fast elim!:finalE)
show ?thesis using e_addr es ex_Throw ves
by(fastforce intro:CallThrowParams)
next
assume not_fin: "¬ final ?ex"
have "finals es = finals(?ves @ ?ex # ?rst)" using es
by(rule arg_cong)
also have "… = finals(?ex # ?rst)" using ves by simp
finally have "finals es = finals(?ex # ?rst)" .
hence fes: "¬ finals es" using not_finals_ConsI[OF not_fin] by blast
have "P,sh ⊢⇩b (es,b) √" using bconf_Call WTrtCall.prems(2)
by (metis e_addr option.simps(5) val_of.simps(1))
thus ?thesis using fes e_addr D IHes by(fastforce intro!:CallParams)
qed
qed
next
fix a assume "e = Throw a"
with WTrtCall.prems show ?thesis by(fast intro!:CallThrowObj)
qed
next
assume nf: "¬ final e"
then have e1: "val_of e = None" proof(cases e)qed(auto)
then have "P,sh ⊢⇩b (e,b) √" using WTrtCall.prems(2) by(simp add:bconf_Call)
with WTrtCall nf e1 show ?thesis by simp (blast intro!:CallObj)
qed
next
case (WTrtCallNT E e es Ts M T) show ?case
proof cases
assume "final e"
moreover
{ fix v assume e: "e = Val v"
hence "e = null" using WTrtCallNT by simp
have ?case
proof cases
assume "finals es"
moreover
{ fix vs assume "es = map Val vs"
with WTrtCallNT e have ?thesis by(fastforce intro: RedCallNull) }
moreover
{ fix vs a es' assume "es = map Val vs @ Throw a # es'"
with WTrtCallNT e have ?thesis by(fastforce intro: CallThrowParams) }
ultimately show ?thesis by(fastforce simp:finals_def)
next
assume nf: "¬ finals es"
have "P,sh ⊢⇩b (es,b) √" using WTrtCallNT.prems(2) e by (simp add: bconf_Call)
with WTrtCallNT e nf show ?thesis by(fastforce intro: CallParams)
qed
}
moreover
{ fix a assume "e = Throw a"
with WTrtCallNT have ?case by(fastforce intro: CallThrowObj) }
ultimately show ?thesis by(fastforce simp:final_def)
next
assume nf: "¬ final e"
then have "val_of e = None" proof(cases e)qed(auto)
then have "P,sh ⊢⇩b (e,b) √" using WTrtCallNT.prems(2) by(simp add:bconf_Call)
with WTrtCallNT nf show ?thesis by (fastforce intro:CallObj)
qed
next
case (WTrtSCall C M Ts T pns body D E es Ts' sfs vs)
have "method": "P ⊢ C sees M,Static:Ts→T = (pns,body) in D"
and wtes: "P,E,h,sh ⊢ es [:] Ts'"and sub: "P ⊢ Ts' [≤] Ts"
and IHes: "⋀l.
⟦𝒟s es ⌊dom l⌋; P,sh ⊢⇩b (es,b) √; ¬ finals es⟧
⟹ ∃es' s' b'. P ⊢ ⟨es,(h,l,sh),b⟩ [→] ⟨es',s',b'⟩"
and clinit: "M = clinit ⟶ sh D = ⌊(sfs, Processing)⌋ ∧ es = map Val vs"
and D: "𝒟 (C∙⇩sM(es)) ⌊dom l⌋" by fact+
show ?case
proof cases
assume es: "∃vs. es = map Val vs"
show ?thesis
proof (cases b)
case True
then show ?thesis
using "method" WTrts_same_length[OF wtes] sub es sees_wf_mdecl[OF wf "method"] True
by(fastforce intro!: RedSCall simp:list_all2_iff wf_mdecl_def)
next
case False
show ?thesis
using "method" clinit WTrts_same_length[OF wtes] sub es False
by (metis (full_types) red_reds.SCallInitDoneRed red_reds.SCallInitRed)
qed
next
assume nmap: "¬(∃vs. es = map Val vs)"
hence not_all_Val: "¬(∀e ∈ set es. ∃v. e = Val v)"
by(simp add:ex_map_conv)
let ?ves = "takeWhile (λe. ∃v. e = Val v) es"
let ?rest = "dropWhile (λe. ∃v. e = Val v) es"
let ?ex = "hd ?rest" let ?rst = "tl ?rest"
from not_all_Val have nonempty: "?rest ≠ []" by auto
hence es: "es = ?ves @ ?ex # ?rst" by simp
have "∀e ∈ set ?ves. ∃v. e = Val v" by(fastforce dest:set_takeWhileD)
then obtain vs where ves: "?ves = map Val vs"
using ex_map_conv by blast
show ?thesis
proof cases
assume "final ?ex"
moreover from nonempty have "¬(∃v. ?ex = Val v)"
by(auto simp:neq_Nil_conv simp del:dropWhile_eq_Nil_conv)
(simp add:dropWhile_eq_Cons_conv)
ultimately obtain b where ex_Throw: "?ex = Throw b"
by(fast elim!:finalE)
show ?thesis using es ex_Throw ves
by(fastforce intro:SCallThrowParams)
next
assume not_fin: "¬ final ?ex"
have "finals es = finals(?ves @ ?ex # ?rst)" using es
by(rule arg_cong)
also have "… = finals(?ex # ?rst)" using ves by simp
finally have "finals es = finals(?ex # ?rst)" .
hence fes: "¬ finals es" using not_finals_ConsI[OF not_fin] by blast
have "P,sh ⊢⇩b (es,b) √"
by (meson WTrtSCall.prems(2) nmap bconf_SCall map_vals_of_spec not_None_eq)
thus ?thesis using fes D IHes by(fastforce intro!:SCallParams)
qed
qed
next
case WTrtNil thus ?case by simp
next
case (WTrtCons E e T es Ts)
have IHe: "⋀l. ⟦𝒟 e ⌊dom l⌋; P,sh ⊢⇩b (e,b) √; ¬ final e⟧
⟹ ∃e' s' b'. P ⊢ ⟨e,(h,l,sh),b⟩ → ⟨e',s',b'⟩"
and IHes: "⋀l. ⟦𝒟s es ⌊dom l⌋; P,sh ⊢⇩b (es,b) √; ¬ finals es⟧
⟹ ∃es' s' b'. P ⊢ ⟨es,(h,l,sh),b⟩ [→] ⟨es',s',b'⟩"
and D: "𝒟s (e#es) ⌊dom l⌋" and not_fins: "¬ finals(e # es)" by fact+
have De: "𝒟 e ⌊dom l⌋" and Des: "𝒟s es (⌊dom l⌋ ⊔ 𝒜 e)"
using D by auto
show ?case
proof cases
assume "final e"
thus ?thesis
proof (rule finalE)
fix v assume e: "e = Val v"
hence Des': "𝒟s es ⌊dom l⌋" using De Des by auto
have bconfs: "P,sh ⊢⇩b (es,b) √" using WTrtCons.prems(2) e by(simp add: bconf_Cons)
have not_fins_tl: "¬ finals es" using not_fins e by simp
show ?thesis using e IHes[OF Des' bconfs not_fins_tl]
by (blast intro!:ListRed2)
next
fix a assume "e = Throw a"
hence False using not_fins by simp
thus ?thesis ..
qed
next
assume nf:"¬ final e"
then have "val_of e = None" proof(cases e)qed(auto)
then have bconf: "P,sh ⊢⇩b (e,b) √" using WTrtCons.prems(2) by(simp add: bconf_Cons)
with IHe[OF De bconf nf] show ?thesis by(fast intro!:ListRed1)
qed
next
case (WTrtInitBlock v T⇩1 T E V e⇩2 T⇩2)
have IH2: "⋀l. ⟦𝒟 e⇩2 ⌊dom l⌋; P,sh ⊢⇩b (e⇩2,b) √; ¬ final e⇩2⟧
⟹ ∃e' s' b'. P ⊢ ⟨e⇩2,(h,l,sh),b⟩ → ⟨e',s',b'⟩"
and D: "𝒟 {V:T := Val v; e⇩2} ⌊dom l⌋" by fact+
show ?case
proof cases
assume "final e⇩2"
then show ?thesis
proof (rule finalE)
fix v⇩2 assume "e⇩2 = Val v⇩2"
thus ?thesis by(fast intro:RedInitBlock)
next
fix a assume "e⇩2 = Throw a"
thus ?thesis by(fast intro:red_reds.InitBlockThrow)
qed
next
assume not_fin2: "¬ final e⇩2"
then have "val_of e⇩2 = None" proof(cases e⇩2)qed(auto)
from D have D2: "𝒟 e⇩2 ⌊dom(l(V↦v))⌋" by (auto simp:hyperset_defs)
have e2conf: "P,sh ⊢⇩b (e⇩2,b) √" using WTrtInitBlock.prems(2) by(simp add: bconf_InitBlock)
from IH2[OF D2 e2conf not_fin2]
obtain h' l' sh' e' b' where red2: "P ⊢ ⟨e⇩2,(h, l(V↦v),sh),b⟩ → ⟨e',(h', l',sh'),b'⟩"
by auto
from red_lcl_incr[OF red2] have "V ∈ dom l'" by auto
with red2 show ?thesis by(fastforce intro:InitBlockRed)
qed
next
case (WTrtBlock E V T e T')
have IH: "⋀l. ⟦𝒟 e ⌊dom l⌋; P,sh ⊢⇩b (e,b) √; ¬ final e⟧
⟹ ∃e' s' b'. P ⊢ ⟨e,(h,l,sh),b⟩ → ⟨e',s',b'⟩"
and unass: "¬ assigned V e" and D: "𝒟 {V:T; e} ⌊dom l⌋" by fact+
show ?case
proof cases
assume "final e"
thus ?thesis
proof (rule finalE)
fix v assume "e = Val v" thus ?thesis by(fast intro:RedBlock)
next
fix a assume "e = Throw a"
thus ?thesis by(fast intro:red_reds.BlockThrow)
qed
next
assume not_fin: "¬ final e"
then have "val_of e = None" proof(cases e)qed(auto)
from D have De: "𝒟 e ⌊dom(l(V:=None))⌋" by(simp add:hyperset_defs)
have bconf: "P,sh ⊢⇩b (e,b) √" using WTrtBlock by(simp add: bconf_Block)
from IH[OF De bconf not_fin]
obtain h' l' sh' e' b' where red: "P ⊢ ⟨e,(h,l(V:=None),sh),b⟩ → ⟨e',(h',l',sh'),b'⟩"
by auto
show ?thesis
proof (cases "l' V")
assume "l' V = None"
with red unass show ?thesis by(blast intro: BlockRedNone)
next
fix v assume "l' V = Some v"
with red unass show ?thesis by(blast intro: BlockRedSome)
qed
qed
next
case (WTrtSeq E e1 T1 e2 T2) show ?case
proof cases
assume "final e1"
thus ?thesis
by(fast elim:finalE intro:RedSeq red_reds.SeqThrow)
next
assume nf: "¬ final e1"
then have e1: "val_of e1 = None" proof(cases e1)qed(auto)
then show ?thesis
proof(cases "lass_val_of e1")
case None
then have "P,sh ⊢⇩b (e1,b) √" using WTrtSeq.prems(2) e1 by(simp add: bconf_Seq)
with WTrtSeq nf e1 None show ?thesis by simp (blast intro:SeqRed)
next
case (Some p)
obtain V v where "e1 = V:=Val v" using lass_val_of_spec[OF Some] by simp
then show ?thesis using SeqRed[OF RedLAss] by blast
qed
qed
next
case (WTrtCond E e e⇩1 T⇩1 e⇩2 T⇩2 T)
have wt: "P,E,h,sh ⊢ e : Boolean" by fact
show ?case
proof cases
assume "final e"
thus ?thesis
proof (rule finalE)
fix v assume val: "e = Val v"
then obtain b where v: "v = Bool b" using wt by auto
show ?thesis
proof (cases b)
case True with val v show ?thesis by(fastforce intro:RedCondT simp: prod_cases3)
next
case False with val v show ?thesis by(fastforce intro:RedCondF simp: prod_cases3)
qed
next
fix a assume "e = Throw a"
thus ?thesis by(fast intro:red_reds.CondThrow)
qed
next
assume nf: "¬ final e"
then have "bool_of e = None" proof(cases e)qed(auto)
then have "P,sh ⊢⇩b (e,b) √" using WTrtCond.prems(2) by(simp add: bconf_Cond)
with WTrtCond nf show ?thesis by simp (blast intro:CondRed)
qed
next
case WTrtWhile show ?case by(fast intro:RedWhile)
next
case (WTrtThrow E e T⇩r T) show ?case
proof cases
assume "final e"
with WTrtThrow show ?thesis
by(fastforce simp:final_def is_refT_def
intro:red_reds.ThrowThrow red_reds.RedThrowNull)
next
assume nf: "¬ final e"
then have "val_of e = None" proof(cases e)qed(auto)
then have "P,sh ⊢⇩b (e,b) √" using WTrtThrow.prems(2) by(simp add: bconf_Throw)
with WTrtThrow nf show ?thesis by simp (blast intro:ThrowRed)
qed
next
case (WTrtTry E e1 T1 V C e2 T2)
have wt1: "P,E,h,sh ⊢ e1 : T1" by fact
show ?case
proof cases
assume "final e1"
thus ?thesis
proof (rule finalE)
fix v assume "e1 = Val v"
thus ?thesis by(fast intro:RedTry)
next
fix a assume e1_Throw: "e1 = Throw a"
with wt1 obtain D fs where ha: "h a = Some(D,fs)" by fastforce
show ?thesis
proof cases
assume "P ⊢ D ≼⇧* C"
with e1_Throw ha show ?thesis by(fastforce intro!:RedTryCatch)
next
assume "¬ P ⊢ D ≼⇧* C"
with e1_Throw ha show ?thesis by(fastforce intro!:RedTryFail)
qed
qed
next
assume nf: "¬ final e1"
then have "val_of e1 = None" proof(cases e1)qed(auto)
then have "P,sh ⊢⇩b (e1,b) √" using WTrtTry.prems(2) by(simp add: bconf_Try)
with WTrtTry nf show ?thesis by simp (fast intro:TryRed)
qed
next
case (WTrtInit E e T⇩r C Cs b) show ?case
proof(cases Cs)
case Nil then show ?thesis using WTrtInit by(fastforce intro!: RedInit)
next
case (Cons C' Cs')
show ?thesis
proof(cases b)
case True then show ?thesis using Cons by(fastforce intro!: RedInitRInit)
next
case False
show ?thesis
proof(cases "sh C'")
case None
then show ?thesis using False Cons by(fastforce intro!: InitNoneRed)
next
case (Some sfsi)
then obtain sfs i where sfsi:"sfsi = (sfs,i)" by(cases sfsi)
show ?thesis
proof(cases i)
case Done
then show ?thesis using False Some sfsi Cons by(fastforce intro!: RedInitDone)
next
case Processing
then show ?thesis using False Some sfsi Cons by(fastforce intro!: RedInitProcessing)
next
case Error
then show ?thesis using False Some sfsi Cons by(fastforce intro!: RedInitError)
next
case Prepared
show ?thesis
proof cases
assume "C' = Object"
then show ?thesis using False Some sfsi Prepared Cons by(fastforce intro: InitObjectRed)
next
assume "C' ≠ Object"
then show ?thesis using False Some sfsi Prepared WTrtInit.hyps(3) Cons
by(simp only: is_class_def)(fastforce intro!: InitNonObjectSuperRed)
qed
qed
qed
qed
qed
next
case (WTrtRI E e T⇩r e' T⇩r' C Cs)
obtain sfs i where shC: "sh C = ⌊(sfs, i)⌋" using WTrtRI.hyps(9) by blast
show ?case
proof cases
assume fin: "final e" then show ?thesis
proof (rule finalE)
fix v assume e: "e = Val v"
then show ?thesis using shC e by(fast intro:RedRInit)
next
fix a assume eThrow: "e = Throw a"
show ?thesis
proof(cases Cs)
case Nil then show ?thesis using eThrow shC by(fastforce intro!: RInitThrow)
next
case Cons then show ?thesis using eThrow shC by(fastforce intro!: RInitInitThrow)
qed
qed
next
assume nf: "¬ final e"
then have "val_of e = None" proof(cases e)qed(auto)
then have "P,sh ⊢⇩b (e,b) √" using WTrtRI.prems(2) by(simp add: bconf_RI)
with WTrtRI nf show ?thesis by simp (meson red_reds.RInitRed)
qed
qed
end
Theory TypeSafe
section ‹ Type Safety Proof ›
theory TypeSafe
imports Progress BigStep SmallStep JWellForm
begin
lemma red_shext_incr: "P ⊢ ⟨e,(h,l,sh),b⟩ → ⟨e',(h',l',sh'),b'⟩
⟹ (⋀E T. P,E,h,sh ⊢ e : T ⟹ sh ⊴⇩s sh')"
and reds_shext_incr: "P ⊢ ⟨es,(h,l,sh),b⟩ [→] ⟨es',(h',l',sh'),b'⟩
⟹ (⋀E Ts. P,E,h,sh ⊢ es [:] Ts ⟹ sh ⊴⇩s sh')"
proof(induct rule:red_reds_inducts) qed(auto simp: shext_def)
lemma wf_types_clinit:
assumes wf:"wf_prog wf_md P" and ex: "class P C = Some a" and proc: "sh C = ⌊(sfs, Processing)⌋"
shows "P,E,h,sh ⊢ C∙⇩sclinit([]) : Void"
proof -
from ex obtain D fs ms where "a = (D,fs,ms)" by(cases a)
then have sP: "(C, D, fs, ms) ∈ set P" using ex map_of_SomeD[of P C a] by(simp add: class_def)
then have "wf_clinit ms" using assms by(unfold wf_prog_def wf_cdecl_def, auto)
then obtain pns body where sm: "(clinit, Static, [], Void, pns, body) ∈ set ms"
by(unfold wf_clinit_def) auto
then have "P ⊢ C sees clinit,Static:[] → Void = (pns,body) in C"
using mdecl_visible[OF wf sP sm] by simp
then show ?thesis using WTrtSCall proc by simp
qed
subsection‹Basic preservation lemmas›
text‹ First some easy preservation lemmas. ›
theorem red_preserves_hconf:
"P ⊢ ⟨e,(h,l,sh),b⟩ → ⟨e',(h',l',sh'),b'⟩ ⟹ (⋀T E. ⟦ P,E,h,sh ⊢ e : T; P ⊢ h √ ⟧ ⟹ P ⊢ h' √)"
and reds_preserves_hconf:
"P ⊢ ⟨es,(h,l,sh),b⟩ [→] ⟨es',(h',l',sh'),b'⟩ ⟹ (⋀Ts E. ⟦ P,E,h,sh ⊢ es [:] Ts; P ⊢ h √ ⟧ ⟹ P ⊢ h' √)"
proof (induct rule:red_reds_inducts)
case (RedNew h a C FDTs h' l sh es)
have new: "new_Addr h = Some a" and fields: "P ⊢ C has_fields FDTs"
and h': "h' = h(a↦blank P C)"
and hconf: "P ⊢ h √" by fact+
from new have None: "h a = None" by(rule new_Addr_SomeD)
moreover have "P,h ⊢ blank P C √"
using fields by(rule oconf_blank)
ultimately show "P ⊢ h' √" using h' by(fast intro: hconf_new[OF hconf])
next
case (RedFAss C F t D h a fs v l sh b')
let ?fs' = "fs((F,D)↦v)"
have hconf: "P ⊢ h √" and ha: "h a = Some(C,fs)"
and wt: "P,E,h,sh ⊢ addr a∙F{D}:=Val v : T" by fact+
from wt ha obtain TF Tv where typeofv: "typeof⇘h⇙ v = Some Tv"
and has: "P ⊢ C has F,NonStatic:TF in D"
and sub: "P ⊢ Tv ≤ TF" by auto
have "P,h ⊢ (C, ?fs') √"
proof (rule oconf_fupd[OF has])
show "P,h ⊢ (C, fs) √" using hconf ha by(simp add:hconf_def)
show "P,h ⊢ v :≤ TF" using sub typeofv by(simp add:conf_def)
qed
with hconf ha show "P ⊢ h(a↦(C, ?fs')) √" by (rule hconf_upd_obj)
qed(auto elim: WTrt.cases)
theorem red_preserves_lconf:
"P ⊢ ⟨e,(h,l,sh),b⟩ → ⟨e',(h',l',sh'),b'⟩ ⟹
(⋀T E. ⟦ P,E,h,sh ⊢ e:T; P,h ⊢ l (:≤) E ⟧ ⟹ P,h' ⊢ l' (:≤) E)"
and reds_preserves_lconf:
"P ⊢ ⟨es,(h,l,sh),b⟩ [→] ⟨es',(h',l',sh'),b'⟩ ⟹
(⋀Ts E. ⟦ P,E,h,sh ⊢ es[:]Ts; P,h ⊢ l (:≤) E ⟧ ⟹ P,h' ⊢ l' (:≤) E)"
proof(induct rule:red_reds_inducts)
case RedNew thus ?case
by(fast intro:lconf_hext red_hext_incr[OF red_reds.RedNew])
next
case RedLAss thus ?case by(fastforce elim: lconf_upd simp:conf_def)
next
case RedFAss thus ?case
by(fast intro:lconf_hext red_hext_incr[OF red_reds.RedFAss])
next
case (InitBlockRed e h l V v sh b e' h' l' sh' b' v' T T')
have red: "P ⊢ ⟨e, (h, l(V↦v),sh),b⟩ → ⟨e',(h', l',sh'),b'⟩"
and IH: "⋀T E . ⟦ P,E,h,sh ⊢ e:T; P,h ⊢ l(V↦v) (:≤) E ⟧
⟹ P,h' ⊢ l' (:≤) E"
and l'V: "l' V = Some v'" and lconf: "P,h ⊢ l (:≤) E"
and wt: "P,E,h,sh ⊢ {V:T := Val v; e} : T'" by fact+
from lconf_hext[OF lconf red_hext_incr[OF red]]
have "P,h' ⊢ l (:≤) E" .
moreover from IH lconf wt have "P,h' ⊢ l' (:≤) E(V↦T)"
by(auto simp del: fun_upd_apply simp: fun_upd_same lconf_upd2 conf_def)
ultimately show "P,h' ⊢ l'(V := l V) (:≤) E"
by (fastforce simp:lconf_def split:if_split_asm)
next
case (BlockRedNone e h l V sh b e' h' l' sh' b' T T')
have red: "P ⊢ ⟨e,(h, l(V := None),sh),b⟩ → ⟨e',(h', l',sh'),b'⟩"
and IH: "⋀E T. ⟦ P,E,h,sh ⊢ e : T; P,h ⊢ l(V:=None) (:≤) E ⟧
⟹ P,h' ⊢ l' (:≤) E"
and lconf: "P,h ⊢ l (:≤) E" and wt: "P,E,h,sh ⊢ {V:T; e} : T'" by fact+
from lconf_hext[OF lconf red_hext_incr[OF red]]
have "P,h' ⊢ l (:≤) E" .
moreover have "P,h' ⊢ l' (:≤) E(V↦T)"
by(rule IH, insert lconf wt, auto simp:lconf_def)
ultimately show "P,h' ⊢ l'(V := l V) (:≤) E"
by (fastforce simp:lconf_def split:if_split_asm)
next
case (BlockRedSome e h l V sh b e' h' l' sh' b' v T T')
have red: "P ⊢ ⟨e,(h, l(V := None),sh),b⟩ → ⟨e',(h', l',sh'),b'⟩"
and IH: "⋀E T. ⟦P,E,h,sh ⊢ e : T; P,h ⊢ l(V:=None) (:≤) E⟧
⟹ P,h' ⊢ l' (:≤) E"
and lconf: "P,h ⊢ l (:≤) E" and wt: "P,E,h,sh ⊢ {V:T; e} : T'" by fact+
from lconf_hext[OF lconf red_hext_incr[OF red]]
have "P,h' ⊢ l (:≤) E" .
moreover have "P,h' ⊢ l' (:≤) E(V↦T)"
by(rule IH, insert lconf wt, auto simp:lconf_def)
ultimately show "P,h' ⊢ l'(V := l V) (:≤) E"
by (fastforce simp:lconf_def split:if_split_asm)
qed(auto elim: WTrt.cases)
theorem red_preserves_shconf:
"P ⊢ ⟨e,(h,l,sh),b⟩ → ⟨e',(h',l',sh'),b'⟩ ⟹ (⋀T E. ⟦ P,E,h,sh ⊢ e : T; P,h ⊢⇩s sh √ ⟧ ⟹ P,h' ⊢⇩s sh' √)"
and reds_preserves_shconf:
"P ⊢ ⟨es,(h,l,sh),b⟩ [→] ⟨es',(h',l',sh'),b'⟩ ⟹ (⋀Ts E. ⟦ P,E,h,sh ⊢ es [:] Ts; P,h ⊢⇩s sh √ ⟧ ⟹ P,h' ⊢⇩s sh' √)"
proof (induct rule:red_reds_inducts)
case (RedNew h a C FDTs h' l sh es)
have new: "new_Addr h = Some a"
and h': "h' = h(a↦blank P C)"
and shconf: "P,h ⊢⇩s sh √" by fact+
from new have None: "h a = None" by(rule new_Addr_SomeD)
then show "P,h' ⊢⇩s sh √" using h' by(fast intro: shconf_hnew[OF shconf])
next
case (RedFAss C F t D h a fs v l sh b)
let ?fs' = "fs((F,D)↦v)"
have shconf: "P,h ⊢⇩s sh √" and ha: "h a = Some(C,fs)" by fact+
then show "P,h(a↦(C, ?fs')) ⊢⇩s sh √" by (rule shconf_hupd_obj)
next
case (RedSFAss C F t D sh sfs i sfs' v sh' h l)
let ?sfs' = "sfs(F↦v)"
have shconf: "P,h ⊢⇩s sh √" and shD: "sh D = ⌊(sfs, i)⌋"
and wt: "P,E,h,sh ⊢ C∙⇩sF{D} := Val v : T" by fact+
from wt obtain TF Tv where typeofv: "typeof⇘h⇙ v = Some Tv"
and has: "P ⊢ C has F,Static:TF in D"
and sub: "P ⊢ Tv ≤ TF" by (auto elim: WTrt.cases)
have has': "P ⊢ D has F,Static:TF in D" using has by(rule has_field_idemp)
have "P,h,D ⊢⇩s ?sfs' √"
proof (rule soconf_fupd[OF has'])
show "P,h,D ⊢⇩s sfs √" using shconf shD by(simp add:shconf_def)
show "P,h ⊢ v :≤ TF" using sub typeofv by(simp add:conf_def)
qed
with shconf have "P,h ⊢⇩s sh(D↦(?sfs',i)) √" by (rule shconf_upd_obj)
then show ?case using RedSFAss.hyps(3) RedSFAss.hyps(4) by blast
next
case (InitNoneRed sh C C' Cs e h l)
let ?sfs' = "sblank P C"
have "P,h ⊢⇩s sh(C ↦ (?sfs', Prepared)) √"
proof(rule shconf_upd_obj)
show "P,h ⊢⇩s sh √" using InitNoneRed by simp
show "P,h,C ⊢⇩s sblank P C √" by (metis has_field_def soconf_def soconf_sblank)
qed
then show ?case by blast
next
case (InitObjectRed sh C sfs sh' C' Cs e h l)
have sh': "sh' = sh(C ↦ (sfs, Processing))" by fact
have "P,h ⊢⇩s sh(C ↦ (sfs, Processing)) √"
proof(rule shconf_upd_obj)
show "P,h ⊢⇩s sh √" using InitObjectRed by simp
moreover have "sh C = ⌊(sfs, Prepared)⌋" using InitObjectRed by simp
ultimately show "P,h,C ⊢⇩s sfs √" using shconfD by blast
qed
then show ?case using sh' by blast
next
case (InitNonObjectSuperRed sh C sfs D a b sh' C' Cs e h l)
have sh': "sh' = sh(C ↦ (sfs, Processing))" by fact
have "P,h ⊢⇩s sh(C ↦ (sfs, Processing)) √"
proof(rule shconf_upd_obj)
show "P,h ⊢⇩s sh √" using InitNonObjectSuperRed by simp
moreover have "sh C = ⌊(sfs, Prepared)⌋" using InitNonObjectSuperRed by simp
ultimately show "P,h,C ⊢⇩s sfs √" using shconfD by blast
qed
then show ?case using sh' by blast
next
case (RedRInit sh C sfs i sh' C' Cs e v h l)
have sh': "sh' = sh(C ↦ (sfs, Done))" by fact
have "P,h ⊢⇩s sh(C ↦ (sfs, Done)) √"
proof(rule shconf_upd_obj)
show "P,h ⊢⇩s sh √" using RedRInit by simp
moreover have "sh C = ⌊(sfs, i)⌋" using RedRInit by simp
ultimately show "P,h,C ⊢⇩s sfs √" using shconfD by blast
qed
then show ?case using sh' by blast
next
case (RInitInitThrow sh C sfs i sh' a D Cs e h l)
have sh': "sh' = sh(C ↦ (sfs, Error))" by fact
have "P,h ⊢⇩s sh(C ↦ (sfs, Error)) √"
proof(rule shconf_upd_obj)
show "P,h ⊢⇩s sh √" using RInitInitThrow by simp
moreover have "sh C = ⌊(sfs, i)⌋" using RInitInitThrow by simp
ultimately show "P,h,C ⊢⇩s sfs √" using shconfD by blast
qed
then show ?case using sh' by blast
next
case (RInitThrow sh C sfs i sh' a e' h l)
have sh': "sh' = sh(C ↦ (sfs, Error))" by fact
have "P,h ⊢⇩s sh(C ↦ (sfs, Error)) √"
proof(rule shconf_upd_obj)
show "P,h ⊢⇩s sh √" using RInitThrow by simp
moreover have "sh C = ⌊(sfs, i)⌋" using RInitThrow by simp
ultimately show "P,h,C ⊢⇩s sfs √" using shconfD by blast
qed
then show ?case using sh' by blast
qed(auto elim: WTrt.cases)
theorem assumes wf: "wwf_J_prog P"
shows red_preserves_iconf:
"P ⊢ ⟨e,(h,l,sh),b⟩ → ⟨e',(h',l',sh'),b'⟩ ⟹ iconf sh e ⟹ iconf sh' e'"
and reds_preserves_iconf:
"P ⊢ ⟨es,(h,l,sh),b⟩ [→] ⟨es',(h',l',sh'),b'⟩ ⟹ iconfs sh es ⟹ iconfs sh' es'"
proof (induct rule:red_reds_inducts)
case (BinOpRed1 e h l sh b e' h' l' sh' b' bop e⇩2)
then show ?case using BinOpRed1 nsub_RI_iconf[of e⇩2 sh'] val_of_spec
proof(cases "val_of e") qed(simp,fast)
next
case (FAssRed1 e h l sh b e' h' l' sh' b' F D e⇩2)
then show ?case using FAssRed1 nsub_RI_iconf[of e⇩2 sh'] val_of_spec
proof(cases "val_of e") qed(simp,fast)
next
case (CallObj e h l sh b e' h' l' sh' b' M es)
then show ?case using CallObj nsub_RIs_iconfs[of es sh'] val_of_spec
proof(cases "val_of e") qed(simp,fast)
next
case RedCall then show ?case using sees_wwf_nsub_RI[OF wf RedCall.hyps(2)]
by (clarsimp simp: assigned_def nsub_RI_iconf)
next
case (RedSCall C M Ts T pns body D vs a a b)
then have "¬sub_RI (blocks (pns, Ts, vs, body))"
using sees_wwf_nsub_RI[OF wf RedSCall.hyps(1)] by simp
then show ?case by(rule nsub_RI_iconf)
next
case SCallInitRed then show ?case by fastforce
next
case (BlockRedNone e h l V sh b e' h' l' sh' b' T)
then show ?case by auto
next
case (SeqRed e h l sh b e' h' l' sh' b' e⇩2)
then show ?case
proof(cases "lass_val_of e")
case None then show ?thesis using SeqRed nsub_RI_iconf by(auto dest: val_of_spec)
next
case (Some a)
have "e' = unit ∧ sh' = sh" by(simp add: lass_val_of_red[OF Some SeqRed(1)])
then show ?thesis using SeqRed Some by(auto dest: val_of_spec)
qed
next
case (ListRed1 e h l sh b e' h' l' sh' b' es)
then show ?case using ListRed1 nsub_RIs_iconfs[of es sh'] val_of_spec
proof(cases "val_of e") qed(simp,fast)
next
case RedInit then show ?case by(auto simp: nsub_RI_iconf)
next
case (RedInitDone sh C sfs C' Cs e h l b)
then show ?case proof(cases Cs) qed(auto simp: initPD_def)
next
case (RedInitProcessing sh C sfs C' Cs e h l b)
then show ?case proof(cases Cs) qed(auto simp: initPD_def)
next
case (RedRInit sh C sfs i sh' C' Cs v e h l b)
then show ?case proof(cases Cs) qed(auto simp: initPD_def)
next
case CallThrowParams then show ?case by(auto simp: iconfs_map_throw)
next
case SCallThrowParams then show ?case by(auto simp: iconfs_map_throw)
qed(auto simp: nsub_RI_iconf lass_val_of_iconf)
lemma Seq_bconf_preserve_aux:
assumes "P ⊢ ⟨e,(h, l, sh),b⟩ → ⟨e',(h', l', sh'),b'⟩" and "P,sh ⊢⇩b (e;; e⇩2,b) √"
and "P,sh ⊢⇩b (e::expr,b) √ ⟶ P,sh' ⊢⇩b (e'::expr,b') √"
shows "P,sh' ⊢⇩b (e';;e⇩2,b') √"
proof(cases "val_of e")
case None show ?thesis
proof(cases "lass_val_of e")
case lNone: None show ?thesis
proof(cases "lass_val_of e'")
case lNone': None
then show ?thesis using None assms lNone
by(auto dest: val_of_spec simp: bconf_def option.distinct(1))
next
case (Some a)
then show ?thesis using None assms lNone by(auto dest: lass_val_of_spec simp: bconf_def)
qed
next
case (Some a)
then show ?thesis using None assms by(auto dest: lass_val_of_spec)
qed
next
case (Some a)
then show ?thesis using assms by(auto dest: val_of_spec)
qed
theorem red_preserves_bconf:
"P ⊢ ⟨e,(h,l,sh),b⟩ → ⟨e',(h',l',sh'),b'⟩ ⟹ iconf sh e ⟹ P,sh ⊢⇩b (e,b) √ ⟹ P,sh' ⊢⇩b (e',b') √"
and reds_preserves_bconf:
"P ⊢ ⟨es,(h,l,sh),b⟩ [→] ⟨es',(h',l',sh'),b'⟩ ⟹ iconfs sh es ⟹ P,sh ⊢⇩b (es,b) √ ⟹ P,sh' ⊢⇩b (es',b') √"
proof (induct rule:red_reds_inducts)
case (CastRed e a a b b e' a a b b' C) then show ?case
proof(cases b') qed(simp, simp add: bconf_def)
next
case (BinOpRed1 e h l sh b e' h' l' sh' b' bop e⇩2) show ?case
proof(cases b')
case True with BinOpRed1 val_of_spec show ?thesis
proof(cases "val_of e") qed(simp,fast)
next
case False then show ?thesis by (simp add: bconf_def)
qed
next
case (BinOpRed2 e a a b b e' a a b b' v⇩1 bop) then show ?case
proof(cases b') qed(simp, simp add: bconf_def)
next
case (LAssRed e a a b b e' a a b b' V) then show ?case
proof(cases b') qed(simp, simp add: bconf_def)
next
case (FAccRed e a a b b e' a a b b' F D) then show ?case
proof(cases b') qed(simp, simp add: bconf_def)
next
case (RedSFAccNonStatic C F t D h l sh b) then show ?case
using has_field_fun[of P C F NonStatic] by (auto simp: bconf_def)
next
case (FAssRed1 e h l sh b e' h' l' sh' b' F D e⇩2) show ?case
proof(cases b')
case True with FAssRed1 val_of_spec show ?thesis
proof(cases "val_of e'")qed((simp,fast)+)
next
case False then show ?thesis by(simp add: bconf_def)
qed
next
case (FAssRed2 e a a b b e' a a b b' v F D) then show ?case
proof(cases b') qed(simp, simp add: bconf_def)
next
case (SFAssRed e h l sh b e' h' l' sh' b' C F D) then show ?case
proof(cases b') qed(fastforce simp: bconf_def val_no_step)+
next
case (RedSFAssNonStatic C F t D v a a b b) then show ?case
using has_field_fun[of P C F NonStatic] by (auto simp: bconf_def)
next
case (CallObj e h l sh b e' h' l' sh' b' M es) show ?case
proof(cases b')
case True with CallObj val_of_spec show ?thesis
proof(cases "val_of e'")qed((simp,fast)+)
next
case False then show ?thesis by(simp add: bconf_def)
qed
next
case (CallParams es a a b b es' a a b b' v M) then show ?case
proof(cases b') qed(simp, simp add: bconf_def)
next
case (SCallParams es h l sh b es' h' l' sh' b' C M) show ?case
proof(cases b')
case b': True show ?thesis
proof(cases "map_vals_of es'")
case None
then show ?thesis using SCallParams b' vals_no_step
proof(cases "map_vals_of es")qed(clarsimp,fast)
next
case f: Some
then show ?thesis using SCallParams b' vals_no_step
proof(cases "map_vals_of es")qed(clarsimp,fast)
qed
next
case False then show ?thesis by(simp add: bconf_def)
qed
next
case (SCallInitDoneRed C M Ts T pns body D sh sfs vs h l)
then show ?case by(auto simp: bconf_def initPD_def) (rule_tac x=D in exI, auto)+
next
case (RedSCallNonStatic C M Ts T a b D vs h l sh b) then show ?case
using sees_method_fun[of P C M NonStatic] by (auto simp: bconf_def)
next
case (BlockRedNone e h l V sh b e' h' l' sh' b' T) show ?case
proof(cases "assigned V e'")
case True
then obtain v e2 where "e' = V := Val v;;e2" by(clarsimp simp: assigned_def)
then show ?thesis using BlockRedNone by(clarsimp simp: bconf_def)
next
case False then show ?thesis using BlockRedNone by simp
qed
next
case (BlockRedSome e h l V sh b e' h' l' sh' b' v T) then show ?case
proof(cases b') qed(simp, simp add: bconf_def)
next
case (InitBlockRed e h l V v sh b e' h' l' sh' b' v' T) show ?case
proof(cases b')
case True
then show ?thesis using InitBlockRed by (simp add: assigned_def)
next
case False then show ?thesis by(simp add: bconf_def)
qed
next
case (RedBlock V T u)
then have "¬assigned V (Val u)" by(clarsimp simp: assigned_def)
then show ?case using RedBlock by(simp add: bconf_def)
next
case (SeqRed e h l sh b e' h' l' sh' b' e⇩2)
have "iconf sh e"
proof(cases "lass_val_of e")
case (Some a) show ?thesis by(rule lass_val_of_iconf[OF Some])
next
case None then show ?thesis using SeqRed by(auto dest: val_of_spec)
qed
then show ?case using SeqRed Seq_bconf_preserve_aux by simp
next
case (CondRed e a a b b e' a a b b' e⇩1 e⇩2) then show ?case
proof(cases b') qed(simp, simp add: bconf_def)
next
case (ThrowRed e a a b b e' a a b b') then show ?case
proof(cases b') qed(simp, simp add: bconf_def)
next
case (TryRed e a a b b e' a a b b' C V e⇩2) then show ?case
proof(cases b') qed(simp, simp add: bconf_def)
next
case (ListRed1 e h l sh b e' h' l' sh' b' es)
with val_of_spec show ?case
proof(cases b') qed((clarsimp,fast),simp add: bconfs_def)
next
case (RedInit C b' e X Y b b'')
then show ?case
by(auto simp: bconf_def icheck_ss_exp icheck_init_class icheck_curr_init)
next
case (RInitRed e a a b b e' a a b b' C Cs e⇩0) then show ?case
proof(cases b') qed(simp, simp add: bconf_def)
next
case (BlockThrow V T a)
then have "¬assigned V (Throw a)" by(simp add: assigned_def)
then show ?case using BlockThrow by simp
qed(simp_all, auto simp: bconf_def initPD_def)
text‹ Preservation of definite assignment more complex and requires a
few lemmas first. ›
lemma [iff]: "⋀A. ⟦ length Vs = length Ts; length vs = length Ts⟧ ⟹
𝒟 (blocks (Vs,Ts,vs,e)) A = 𝒟 e (A ⊔ ⌊set Vs⌋)"
apply(induct Vs Ts vs e rule:blocks_induct)
apply(simp_all add:hyperset_defs)
done
lemma red_lA_incr: "P ⊢ ⟨e,(h,l,sh),b⟩ → ⟨e',(h',l',sh'),b'⟩
⟹ ⌊dom l⌋ ⊔ 𝒜 e ⊑ ⌊dom l'⌋ ⊔ 𝒜 e'"
and reds_lA_incr: "P ⊢ ⟨es,(h,l,sh),b⟩ [→] ⟨es',(h',l',sh'),b'⟩
⟹ ⌊dom l⌋ ⊔ 𝒜s es ⊑ ⌊dom l'⌋ ⊔ 𝒜s es'"
apply(induct rule:red_reds_inducts)
apply(simp_all del:fun_upd_apply add:hyperset_defs)
apply auto
apply(blast dest:red_lcl_incr)+
done
text‹ Now preservation of definite assignment. ›
lemma assumes wf: "wf_J_prog P"
shows red_preserves_defass:
"P ⊢ ⟨e,(h,l,sh),b⟩ → ⟨e',(h',l',sh'),b'⟩ ⟹ 𝒟 e ⌊dom l⌋ ⟹ 𝒟 e' ⌊dom l'⌋"
and "P ⊢ ⟨es,(h,l,sh),b⟩ [→] ⟨es',(h',l',sh'),b'⟩ ⟹ 𝒟s es ⌊dom l⌋ ⟹ 𝒟s es' ⌊dom l'⌋"
proof (induct rule:red_reds_inducts)
case BinOpRed1 thus ?case by (auto elim!: D_mono[OF red_lA_incr])
next
case FAssRed1 thus ?case by (auto elim!: D_mono[OF red_lA_incr])
next
case CallObj thus ?case by (auto elim!: Ds_mono[OF red_lA_incr])
next
case RedCall thus ?case
by (auto dest!:sees_wf_mdecl[OF wf] simp:wf_mdecl_def hyperset_defs elim!:D_mono')
next
case RedSCall thus ?case
by (auto dest!:sees_wf_mdecl[OF wf] simp:wf_mdecl_def hyperset_defs elim!:D_mono')
next
case SCallInitRed
then show ?case by(auto simp:hyperset_defs Ds_Vals)
next
case InitBlockRed thus ?case
by(auto simp:hyperset_defs elim!:D_mono' simp del:fun_upd_apply)
next
case BlockRedNone thus ?case
by(auto simp:hyperset_defs elim!:D_mono' simp del:fun_upd_apply)
next
case BlockRedSome thus ?case
by(auto simp:hyperset_defs elim!:D_mono' simp del:fun_upd_apply)
next
case SeqRed thus ?case by (auto elim!: D_mono[OF red_lA_incr])
next
case CondRed thus ?case by (auto elim!: D_mono[OF red_lA_incr])
next
case TryRed thus ?case
by (fastforce dest:red_lcl_incr intro:D_mono' simp:hyperset_defs)
next
case ListRed1 thus ?case by (auto elim!: Ds_mono[OF red_lA_incr])
next
case RedWhile thus ?case by(auto simp:hyperset_defs elim!:D_mono')
next
case RedInit then show ?case by (auto intro: D_mono' simp: hyperset_defs)
next
case (RInitRed e h l sh b e' h' l' sh' b' C Cs e⇩0)
then show ?case by(auto simp:hyperset_defs dest:red_lcl_incr elim!:D_mono')
qed(auto simp:hyperset_defs)
text‹ Combining conformance of heap, static heap, and local variables: ›
definition sconf :: "J_prog ⇒ env ⇒ state ⇒ bool" ("_,_ ⊢ _ √" [51,51,51]50)
where
"P,E ⊢ s √ ≡ let (h,l,sh) = s in P ⊢ h √ ∧ P,h ⊢ l (:≤) E ∧ P,h ⊢⇩s sh √"
lemma red_preserves_sconf:
"⟦ P ⊢ ⟨e,s,b⟩ → ⟨e',s',b'⟩; P,E,hp s,shp s ⊢ e : T; P,E ⊢ s √ ⟧ ⟹ P,E ⊢ s' √"
by(fastforce intro:red_preserves_hconf red_preserves_lconf red_preserves_shconf
simp add:sconf_def)
lemma reds_preserves_sconf:
"⟦ P ⊢ ⟨es,s,b⟩ [→] ⟨es',s',b'⟩; P,E,hp s,shp s ⊢ es [:] Ts; P,E ⊢ s √ ⟧ ⟹ P,E ⊢ s' √"
by(fastforce intro:reds_preserves_hconf reds_preserves_lconf reds_preserves_shconf
simp add:sconf_def)
subsection "Subject reduction"
lemma wt_blocks:
"⋀E. ⟦ length Vs = length Ts; length vs = length Ts ⟧ ⟹
(P,E,h,sh ⊢ blocks(Vs,Ts,vs,e) : T) =
(P,E(Vs[↦]Ts),h,sh ⊢ e:T ∧ (∃Ts'. map (typeof⇘h⇙) vs = map Some Ts' ∧ P ⊢ Ts' [≤] Ts))"
apply(induct Vs Ts vs e rule:blocks_induct)
apply (force simp add:rel_list_all2_Cons2)
apply simp_all
done
theorem assumes wf: "wf_J_prog P"
shows subject_reduction2: "P ⊢ ⟨e,(h,l,sh),b⟩ → ⟨e',(h',l',sh'),b'⟩ ⟹
(⋀E T. ⟦ P,E ⊢ (h,l,sh) √; iconf sh e; P,E,h,sh ⊢ e:T ⟧
⟹ ∃T'. P,E,h',sh' ⊢ e':T' ∧ P ⊢ T' ≤ T)"
and subjects_reduction2: "P ⊢ ⟨es,(h,l,sh),b⟩ [→] ⟨es',(h',l',sh'),b'⟩ ⟹
(⋀E Ts. ⟦ P,E ⊢ (h,l,sh) √; iconfs sh es; P,E,h,sh ⊢ es [:] Ts ⟧
⟹ ∃Ts'. P,E,h',sh' ⊢ es' [:] Ts' ∧ P ⊢ Ts' [≤] Ts)"
proof (induct rule:red_reds_inducts)
case RedNew then show ?case by (auto simp: blank_def)
next
case RedNewFail thus ?case
by (unfold sconf_def hconf_def) (fastforce elim!:typeof_OutOfMemory)
next
case CastRed thus ?case
by(clarsimp simp:is_refT_def)
(blast intro: widens_trans dest!:widen_Class[THEN iffD1])
next
case RedCastFail thus ?case
by (unfold sconf_def hconf_def) (fastforce elim!:typeof_ClassCast)
next
case (BinOpRed1 e⇩1 h l sh b e⇩1' h' l' sh' b' bop e⇩2)
have red: "P ⊢ ⟨e⇩1,(h,l,sh),b⟩ → ⟨e⇩1',(h',l',sh'),b'⟩"
and IH: "⋀E T. ⟦P,E ⊢ (h,l,sh) √; iconf sh e⇩1; P,E,h,sh ⊢ e⇩1:T⟧
⟹ ∃U. P,E,h',sh' ⊢ e⇩1' : U ∧ P ⊢ U ≤ T"
and conf: "P,E ⊢ (h,l,sh) √" and iconf: "iconf sh (e⇩1 «bop» e⇩2)"
and wt: "P,E,h,sh ⊢ e⇩1 «bop» e⇩2 : T" by fact+
have val: "val_of e⇩1 = None" using red iconf val_no_step by auto
then have iconf1: "iconf sh e⇩1" and nsub_RI2: "¬sub_RI e⇩2" using iconf by simp+
have "P,E,h',sh' ⊢ e⇩1' «bop» e⇩2 : T"
proof (cases bop)
assume [simp]: "bop = Eq"
from wt obtain T⇩1 T⇩2 where [simp]: "T = Boolean"
and wt⇩1: "P,E,h,sh ⊢ e⇩1 : T⇩1" and wt⇩2: "P,E,h,sh ⊢ e⇩2 : T⇩2" by auto
show ?thesis
using WTrt_hext_shext_mono[OF wt⇩2 red_hext_incr[OF red] red_shext_incr[OF red wt⇩1] nsub_RI2]
IH[OF conf iconf1 wt⇩1] by auto
next
assume [simp]: "bop = Add"
from wt have [simp]: "T = Integer"
and wt⇩1: "P,E,h,sh ⊢ e⇩1 : Integer" and wt⇩2: "P,E,h,sh ⊢ e⇩2 : Integer"
by auto
show ?thesis
using WTrt_hext_shext_mono[OF wt⇩2 red_hext_incr[OF red] red_shext_incr[OF red wt⇩1] nsub_RI2]
IH[OF conf iconf1 wt⇩1] by auto
qed
thus ?case by auto
next
case (BinOpRed2 e⇩2 h l sh b e⇩2' h' l' sh' b' v⇩1 bop)
have red: "P ⊢ ⟨e⇩2,(h,l,sh),b⟩ → ⟨e⇩2',(h',l',sh'),b'⟩"
and IH: "⋀E T. ⟦P,E ⊢ (h,l,sh) √; iconf sh e⇩2; P,E,h,sh ⊢ e⇩2:T⟧
⟹ ∃U. P,E,h',sh' ⊢ e⇩2' : U ∧ P ⊢ U ≤ T"
and conf: "P,E ⊢ (h,l,sh) √" and iconf: "iconf sh (Val v⇩1 «bop» e⇩2)"
and wt: "P,E,h,sh ⊢ (Val v⇩1) «bop» e⇩2 : T" by fact+
have iconf2: "iconf sh e⇩2" using iconf by simp
have "P,E,h',sh' ⊢ (Val v⇩1) «bop» e⇩2' : T"
proof (cases bop)
assume [simp]: "bop = Eq"
from wt obtain T⇩1 T⇩2 where [simp]: "T = Boolean"
and wt⇩1: "P,E,h,sh ⊢ Val v⇩1 : T⇩1" and wt⇩2: "P,E,h,sh ⊢ e⇩2:T⇩2" by auto
show ?thesis
using IH[OF conf iconf2 wt⇩2] WTrt_hext_mono[OF wt⇩1 red_hext_incr[OF red]]
by auto
next
assume [simp]: "bop = Add"
from wt have [simp]: "T = Integer"
and wt⇩1: "P,E,h,sh ⊢ Val v⇩1 : Integer" and wt⇩2: "P,E,h,sh ⊢ e⇩2 : Integer"
by auto
show ?thesis
using IH[OF conf iconf2 wt⇩2] WTrt_hext_mono[OF wt⇩1 red_hext_incr[OF red]]
by auto
qed
thus ?case by auto
next
case (RedBinOp bop) thus ?case
proof (cases bop)
case Eq thus ?thesis using RedBinOp by auto
next
case Add thus ?thesis using RedBinOp by auto
qed
next
case RedVar thus ?case by (fastforce simp:sconf_def lconf_def conf_def)
next
case (LAssRed e h l sh b e' h' l' sh' b' V)
obtain Te where Te: "P,E,h,sh ⊢ e : Te ∧ P ⊢ Te ≤ the(E V)" using LAssRed.prems(3) by auto
then have wide: "P ⊢ Te ≤ the(E V)" using LAssRed by simp
then have "∃T'. P,E,h',sh' ⊢ e' : T' ∧ P ⊢ T' ≤ Te"
using LAssRed.hyps(2) LAssRed.prems(1,2) Te widen_trans[OF _ wide] by auto
then obtain T' where wt: "P,E,h',sh' ⊢ e' : T' ∧ P ⊢ T' ≤ Te" by clarsimp
have "P,E,h',sh' ⊢ V:=e' : Void" using LAssRed wt widen_trans[OF _ wide] by auto
then show ?case using LAssRed by(rule_tac x = Void in exI) auto
next
case (FAccRed e h l sh b e' h' l' sh' b' F D)
have IH: "⋀E T. ⟦P,E ⊢ (h,l,sh) √; iconf sh e; P,E,h,sh ⊢ e : T⟧
⟹ ∃U. P,E,h',sh' ⊢ e' : U ∧ P ⊢ U ≤ T"
and conf: "P,E ⊢ (h,l,sh) √" and iconf: "iconf sh (e∙F{D})"
and wt: "P,E,h,sh ⊢ e∙F{D} : T" by fact+
have iconf': "iconf sh e" using iconf by simp+
{ fix C assume wte: "P,E,h,sh ⊢ e : Class C"
and has: "P ⊢ C has F,NonStatic:T in D"
from IH[OF conf iconf' wte]
obtain U where wte': "P,E,h',sh' ⊢ e' : U" and UsubC: "P ⊢ U ≤ Class C"
by auto
{ assume "U = NT" hence ?case using wte'
by(blast intro:WTrtFAccNT widen_refl) }
moreover
{ fix C' assume U: "U = Class C'" and C'subC: "P ⊢ C' ≼⇧* C"
from has_field_mono[OF has C'subC] wte' U
have ?case by(blast intro:WTrtFAcc) }
ultimately have ?case using UsubC by(simp add: widen_Class) blast }
moreover
{ assume "P,E,h,sh ⊢ e : NT"
hence "P,E,h',sh' ⊢ e' : NT" using IH[OF conf iconf'] by fastforce
hence ?case by(fastforce intro:WTrtFAccNT widen_refl) }
ultimately show ?case using wt by blast
next
case RedFAcc thus ?case
by(fastforce simp:sconf_def hconf_def oconf_def conf_def has_field_def
dest:has_fields_fun)
next
case RedFAccNull thus ?case
by(fastforce intro: widen_refl WTThrow[OF WTVal] elim!: typeof_NullPointer
simp: sconf_def hconf_def)
next
case RedSFAccNone then show ?case
by(fastforce intro: WTrtThrow[OF WTrtVal] elim!: typeof_NoSuchFieldError
simp: sconf_def hconf_def)
next
case RedFAccStatic then show ?case
by(fastforce intro: WTrtThrow[OF WTrtVal] elim!: typeof_IncompatibleClassChangeError
simp: sconf_def hconf_def)
next
case (RedSFAcc C F t D sh sfs i v h l es)
then have "P ⊢ C has F,Static:T in D" by fast
then have dM: "P ⊢ D has F,Static:T in D" by(rule has_field_idemp)
then show ?case using RedSFAcc by(fastforce simp:sconf_def shconf_def soconf_def conf_def)
next
case SFAccInitDoneRed then show ?case by (meson widen_refl)
next
case (SFAccInitRed C F t D sh h l E T)
have "is_class P D" using SFAccInitRed.hyps(1) by(rule has_field_is_class')
then have "P,E,h,sh ⊢ INIT D ([D],False) ← C∙⇩sF{D} : T ∧ P ⊢ T ≤ T"
using SFAccInitRed WTrtInit[OF SFAccInitRed.prems(3)] by clarsimp
then show ?case by(rule exI)
next
case RedSFAccNonStatic then show ?case
by(fastforce intro: WTrtThrow[OF WTrtVal] elim!: typeof_IncompatibleClassChangeError
simp: sconf_def hconf_def)
next
case (FAssRed1 e h l sh b e' h' l' sh' b' F D e⇩2)
have red: "P ⊢ ⟨e,(h,l,sh),b⟩ → ⟨e',(h',l',sh'),b'⟩"
and IH: "⋀E T. ⟦P,E ⊢ (h,l,sh) √; iconf sh e; P,E,h,sh ⊢ e : T⟧
⟹ ∃U. P,E,h',sh' ⊢ e' : U ∧ P ⊢ U ≤ T"
and conf: "P,E ⊢ (h,l,sh) √" and iconf: "iconf sh (e∙F{D} := e⇩2)"
and wt: "P,E,h,sh ⊢ e∙F{D}:=e⇩2 : T" by fact+
have val: "val_of e = None" using red iconf val_no_step by auto
then have iconf': "iconf sh e" and nsub_RI2: "¬sub_RI e⇩2" using iconf by simp+
from wt have void: "T = Void" by blast
{ assume wt':"P,E,h,sh ⊢ e : NT"
hence "P,E,h',sh' ⊢ e' : NT" using IH[OF conf iconf'] by fastforce
moreover obtain T⇩2 where "P,E,h,sh ⊢ e⇩2 : T⇩2" using wt by auto
from this red_hext_incr[OF red] red_shext_incr[OF red wt'] nsub_RI2 have "P,E,h',sh' ⊢ e⇩2 : T⇩2"
by(rule WTrt_hext_shext_mono)
ultimately have ?case using void by(blast intro!:WTrtFAssNT)
}
moreover
{ fix C TF T⇩2 assume wt⇩1: "P,E,h,sh ⊢ e : Class C" and wt⇩2: "P,E,h,sh ⊢ e⇩2 : T⇩2"
and has: "P ⊢ C has F,NonStatic:TF in D" and sub: "P ⊢ T⇩2 ≤ TF"
obtain U where wt⇩1': "P,E,h',sh' ⊢ e' : U" and UsubC: "P ⊢ U ≤ Class C"
using IH[OF conf iconf' wt⇩1] by blast
have wt⇩2': "P,E,h',sh' ⊢ e⇩2 : T⇩2"
by(rule WTrt_hext_shext_mono[OF wt⇩2 red_hext_incr[OF red] red_shext_incr[OF red wt⇩1] nsub_RI2])
{ assume "U = NT" with wt⇩1' wt⇩2' void have ?case
by(blast intro!:WTrtFAssNT) }
moreover
{ fix C' assume UClass: "U = Class C'" and "subclass": "P ⊢ C' ≼⇧* C"
have "P,E,h',sh' ⊢ e' : Class C'" using wt⇩1' UClass by auto
moreover have "P ⊢ C' has F,NonStatic:TF in D"
by(rule has_field_mono[OF has "subclass"])
ultimately have ?case using wt⇩2' sub void by(blast intro:WTrtFAss) }
ultimately have ?case using UsubC by(auto simp add:widen_Class) }
ultimately show ?case using wt by blast
next
case (FAssRed2 e⇩2 h l sh b e⇩2' h' l' sh' b' v F D)
have red: "P ⊢ ⟨e⇩2,(h,l,sh),b⟩ → ⟨e⇩2',(h',l',sh'),b'⟩"
and IH: "⋀E T. ⟦P,E ⊢ (h,l,sh) √; iconf sh e⇩2; P,E,h,sh ⊢ e⇩2 : T⟧
⟹ ∃U. P,E,h',sh' ⊢ e⇩2' : U ∧ P ⊢ U ≤ T"
and conf: "P,E ⊢ (h,l,sh) √" and iconf: "iconf sh (Val v∙F{D} := e⇩2)"
and wt: "P,E,h,sh ⊢ Val v∙F{D}:=e⇩2 : T" by fact+
have iconf2: "iconf sh e⇩2" using iconf by simp
from wt have [simp]: "T = Void" by auto
from wt show ?case
proof (rule WTrt_elim_cases)
fix C TF T⇩2
assume wt⇩1: "P,E,h,sh ⊢ Val v : Class C"
and has: "P ⊢ C has F,NonStatic:TF in D"
and wt⇩2: "P,E,h,sh ⊢ e⇩2 : T⇩2" and TsubTF: "P ⊢ T⇩2 ≤ TF"
have wt⇩1': "P,E,h',sh' ⊢ Val v : Class C"
using WTrt_hext_mono[OF wt⇩1 red_hext_incr[OF red]] by auto
obtain T⇩2' where wt⇩2': "P,E,h',sh' ⊢ e⇩2' : T⇩2'" and T'subT: "P ⊢ T⇩2' ≤ T⇩2"
using IH[OF conf iconf2 wt⇩2] by blast
have "P,E,h',sh' ⊢ Val v∙F{D}:=e⇩2' : Void"
by(rule WTrtFAss[OF wt⇩1' has wt⇩2' widen_trans[OF T'subT TsubTF]])
thus ?case by auto
next
fix T⇩2 assume null: "P,E,h,sh ⊢ Val v : NT" and wt⇩2: "P,E,h,sh ⊢ e⇩2 : T⇩2"
from null have "v = Null" by simp
moreover
obtain T⇩2' where "P,E,h',sh' ⊢ e⇩2' : T⇩2' ∧ P ⊢ T⇩2' ≤ T⇩2"
using IH[OF conf iconf2 wt⇩2] by blast
ultimately show ?thesis by(fastforce intro:WTrtFAssNT)
qed
next
case RedFAss thus ?case by(auto simp del:fun_upd_apply)
next
case RedFAssNull thus ?case
by(fastforce intro: WTThrow[OF WTVal] elim!:typeof_NullPointer simp:sconf_def hconf_def)
next
case RedFAssStatic then show ?case
by(fastforce intro: WTrtThrow[OF WTrtVal] elim!: typeof_IncompatibleClassChangeError
simp: sconf_def hconf_def)
next
case (SFAssRed e h l sh b e' h' l' sh' b' C F D E T)
have IH: "⋀E T. ⟦P,E ⊢ (h,l,sh) √; iconf sh e; P,E,h,sh ⊢ e : T⟧
⟹ ∃U. P,E,h',sh' ⊢ e' : U ∧ P ⊢ U ≤ T"
and conf: "P,E ⊢ (h,l,sh) √" and iconf: "iconf sh (C∙⇩sF{D} := e)"
and wt: "P,E,h,sh ⊢ C∙⇩sF{D}:=e : T" by fact+
have iconf': "iconf sh e" using iconf by simp
from wt have [simp]: "T = Void" by auto
from wt show ?case
proof (rule WTrt_elim_cases)
fix TF T1
assume has: "P ⊢ C has F,Static:TF in D"
and wt1: "P,E,h,sh ⊢ e : T1" and TsubTF: "P ⊢ T1 ≤ TF"
obtain T' where wt1': "P,E,h',sh' ⊢ e' : T'" and T'subT: "P ⊢ T' ≤ T1"
using IH[OF conf iconf' wt1] by blast
have "P,E,h',sh' ⊢ C∙⇩sF{D}:=e' : Void"
by(rule WTrtSFAss[OF wt1' has widen_trans[OF T'subT TsubTF]])
thus ?case by auto
qed
next
case SFAssInitDoneRed then show ?case by (meson widen_refl)
next
case (SFAssInitRed C F t D sh v h l E T)
have "is_class P D" using SFAssInitRed.hyps(1) by(rule has_field_is_class')
then have "P,E,h,sh ⊢ INIT D ([D],False) ← C∙⇩sF{D} := Val v : T ∧ P ⊢ T ≤ T"
using SFAssInitRed WTrtInit[OF SFAssInitRed.prems(3)] by clarsimp
then show ?case by(rule exI)
next
case RedSFAssNone then show ?case
by(fastforce intro: WTrtThrow[OF WTrtVal] elim!: typeof_NoSuchFieldError
simp: sconf_def hconf_def)
next
case RedSFAssNonStatic then show ?case
by(fastforce intro: WTrtThrow[OF WTrtVal] elim!: typeof_IncompatibleClassChangeError
simp: sconf_def hconf_def)
next
case (CallObj e h l sh b e' h' l' sh' b' M es)
have red: "P ⊢ ⟨e,(h,l,sh),b⟩ → ⟨e',(h',l',sh'),b'⟩"
and IH: "⋀E T. ⟦P,E ⊢ (h,l,sh) √; iconf sh e; P,E,h,sh ⊢ e : T⟧
⟹ ∃U. P,E,h',sh' ⊢ e' : U ∧ P ⊢ U ≤ T"
and conf: "P,E ⊢ (h,l,sh) √" and iconf: "iconf sh (e∙M(es))"
and wt: "P,E,h,sh ⊢ e∙M(es) : T" by fact+
have val: "val_of e = None" using red iconf val_no_step by auto
then have iconf': "iconf sh e" and nsub_RIs: "¬sub_RIs es" using iconf by simp+
{ assume wt':"P,E,h,sh ⊢ e:NT"
hence "P,E,h',sh' ⊢ e' : NT" using IH[OF conf iconf'] by fastforce
moreover
fix Ts assume wtes: "P,E,h,sh ⊢ es [:] Ts"
have "P,E,h',sh' ⊢ es [:] Ts"
by(rule WTrts_hext_shext_mono[OF wtes red_hext_incr[OF red] red_shext_incr[OF red wt'] nsub_RIs])
ultimately have ?case by(blast intro!:WTrtCallNT) }
moreover
{ fix C D Ts Us pns body
assume wte: "P,E,h,sh ⊢ e : Class C"
and "method": "P ⊢ C sees M,NonStatic:Ts→T = (pns,body) in D"
and wtes: "P,E,h,sh ⊢ es [:] Us" and subs: "P ⊢ Us [≤] Ts"
obtain U where wte': "P,E,h',sh' ⊢ e' : U" and UsubC: "P ⊢ U ≤ Class C"
using IH[OF conf iconf' wte] by blast
{ assume "U = NT"
moreover have "P,E,h',sh' ⊢ es [:] Us"
by(rule WTrts_hext_shext_mono[OF wtes red_hext_incr[OF red] red_shext_incr[OF red wte] nsub_RIs])
ultimately have ?case using wte' by(blast intro!:WTrtCallNT) }
moreover
{ fix C' assume UClass: "U = Class C'" and "subclass": "P ⊢ C' ≼⇧* C"
have "P,E,h',sh' ⊢ e' : Class C'" using wte' UClass by auto
moreover obtain Ts' T' pns' body' D'
where method': "P ⊢ C' sees M,NonStatic:Ts'→T' = (pns',body') in D'"
and subs': "P ⊢ Ts [≤] Ts'" and sub': "P ⊢ T' ≤ T"
using Call_lemma[OF "method" "subclass" wf] by fast
moreover have "P,E,h',sh' ⊢ es [:] Us"
by(rule WTrts_hext_shext_mono[OF wtes red_hext_incr[OF red] red_shext_incr[OF red wte] nsub_RIs])
ultimately have ?case
using subs by(blast intro:WTrtCall rtrancl_trans widens_trans) }
ultimately have ?case using UsubC by(auto simp add:widen_Class) }
ultimately show ?case using wt by auto
next
case (CallParams es h l sh b es' h' l' sh' b' v M)
have reds: "P ⊢ ⟨es,(h,l,sh),b⟩ [→] ⟨es',(h',l',sh'),b'⟩"
and IH: "⋀E Ts. ⟦P,E ⊢ (h,l,sh) √; iconfs sh es; P,E,h,sh ⊢ es [:] Ts⟧
⟹ ∃Us. P,E,h',sh' ⊢ es' [:] Us ∧ P ⊢ Us [≤] Ts"
and conf: "P,E ⊢ (h,l,sh) √" and iconf: "iconf sh (Val v∙M(es))"
and wt: "P,E,h,sh ⊢ Val v∙M(es) : T" by fact+
have iconfs: "iconfs sh es" using iconf by simp
from wt show ?case
proof (rule WTrt_elim_cases)
fix C D Ts Us pns body
assume wte: "P,E,h,sh ⊢ Val v : Class C"
and "P ⊢ C sees M,NonStatic:Ts→T = (pns,body) in D"
and wtes: "P,E,h,sh ⊢ es [:] Us" and "P ⊢ Us [≤] Ts"
moreover have "P,E,h',sh' ⊢ Val v : Class C"
using WTrt_hext_mono[OF wte reds_hext_incr[OF reds]] by auto
moreover
obtain Us' where "P,E,h',sh' ⊢ es' [:] Us' ∧ P ⊢ Us' [≤] Us"
using IH[OF conf iconfs wtes] by blast
ultimately show ?thesis by(blast intro:WTrtCall widens_trans)
next
fix Us
assume null: "P,E,h,sh ⊢ Val v : NT" and wtes: "P,E,h,sh ⊢ es [:] Us"
from null have "v = Null" by simp
moreover
obtain Us' where "P,E,h',sh' ⊢ es' [:] Us' ∧ P ⊢ Us' [≤] Us"
using IH[OF conf iconfs wtes] by blast
ultimately show ?thesis by(fastforce intro:WTrtCallNT)
qed
next
case (RedCall h a C fs M Ts T pns body D vs l sh b E T')
have hp: "h a = Some(C,fs)"
and "method": "P ⊢ C sees M,NonStatic: Ts→T = (pns,body) in D"
and wt: "P,E,h,sh ⊢ addr a∙M(map Val vs) : T'" by fact+
obtain Ts' where wtes: "P,E,h,sh ⊢ map Val vs [:] Ts'"
and subs: "P ⊢ Ts' [≤] Ts" and T'isT: "T' = T"
using wt "method" hp by (auto dest:sees_method_fun)
from wtes subs have length_vs: "length vs = length Ts"
by(fastforce simp:list_all2_iff dest!:WTrts_same_length)
from sees_wf_mdecl[OF wf "method"] obtain T''
where wtabody: "P,[this#pns [↦] Class D#Ts] ⊢ body :: T''"
and T''subT: "P ⊢ T'' ≤ T" and length_pns: "length pns = length Ts"
by(fastforce simp:wf_mdecl_def simp del:map_upds_twist)
from wtabody have "P,Map.empty(this#pns [↦] Class D#Ts),h,sh ⊢ body : T''"
by(rule WT_implies_WTrt)
hence "P,E(this#pns [↦] Class D#Ts),h,sh ⊢ body : T''"
by(rule WTrt_env_mono) simp
hence "P,E,h,sh ⊢ blocks(this#pns, Class D#Ts, Addr a#vs, body) : T''"
using wtes subs hp sees_method_decl_above[OF "method"] length_vs length_pns
by(fastforce simp add:wt_blocks rel_list_all2_Cons2)
with T''subT T'isT show ?case by blast
next
case RedCallNull thus ?case
by(fastforce intro: WTThrow[OF WTVal] elim!:typeof_NullPointer simp: sconf_def hconf_def)
next
case RedCallStatic then show ?case
by(fastforce intro: WTrtThrow[OF WTrtVal] elim!: typeof_IncompatibleClassChangeError
simp: sconf_def hconf_def)
next
case (SCallParams es h l sh b es' h' l' sh' b' C M)
have IH: "⋀E Ts. ⟦P,E ⊢ (h,l,sh) √; iconfs sh es; P,E,h,sh ⊢ es [:] Ts⟧
⟹ ∃Us. P,E,h',sh' ⊢ es' [:] Us ∧ P ⊢ Us [≤] Ts"
and conf: "P,E ⊢ (h,l,sh) √" and iconf: "iconf sh (C∙⇩sM(es))"
and wt: "P,E,h,sh ⊢ C∙⇩sM(es) : T" by fact+
have iconfs: "iconfs sh es" using iconf by simp
from wt show ?case
proof (rule WTrt_elim_cases)
fix D Ts Us pns body sfs vs
assume method: "P ⊢ C sees M,Static:Ts→T = (pns,body) in D"
and wtes: "P,E,h,sh ⊢ es [:] Us" and us: "P ⊢ Us [≤] Ts"
and clinit: "M = clinit ⟶ sh D = ⌊(sfs,Processing)⌋ ∧ es = map Val vs"
obtain Us' where es': "P,E,h',sh' ⊢ es' [:] Us'" and us': "P ⊢ Us' [≤] Us"
using IH[OF conf iconfs wtes] by blast
show ?thesis
proof(cases "M = clinit")
case True then show ?thesis using clinit SCallParams.hyps(1) by blast
next
case False
then show ?thesis using es' method us us' by(blast intro:WTrtSCall widens_trans)
qed
qed
next
case (RedSCall C M Ts T pns body D vs h l sh E T')
have "method": "P ⊢ C sees M,Static: Ts→T = (pns,body) in D"
and wt: "P,E,h,sh ⊢ C∙⇩sM(map Val vs) : T'" by fact+
obtain Ts' where wtes: "P,E,h,sh ⊢ map Val vs [:] Ts'"
and subs: "P ⊢ Ts' [≤] Ts" and T'isT: "T' = T"
using wt "method" map_Val_eq by(auto dest:sees_method_fun)+
from wtes subs have length_vs: "length vs = length Ts"
by(fastforce simp:list_all2_iff dest!:WTrts_same_length)
from sees_wf_mdecl[OF wf "method"] obtain T''
where wtabody: "P,[pns [↦] Ts] ⊢ body :: T''"
and T''subT: "P ⊢ T'' ≤ T" and length_pns: "length pns = length Ts"
by(fastforce simp:wf_mdecl_def simp del:map_upds_twist)
from wtabody have "P,Map.empty(pns [↦] Ts),h,sh ⊢ body : T''"
by(rule WT_implies_WTrt)
hence "P,E(pns [↦] Ts),h,sh ⊢ body : T''"
by(rule WTrt_env_mono) simp
hence "P,E,h,sh ⊢ blocks(pns, Ts, vs, body) : T''"
using wtes subs sees_method_decl_above[OF "method"] length_vs length_pns
by(fastforce simp add:wt_blocks rel_list_all2_Cons2)
with T''subT T'isT show ?case by blast
next
case SCallInitDoneRed then show ?case by (meson widen_refl)
next
case (SCallInitRed C F Ts t pns body D sh v h l E T)
have "is_class P D" using SCallInitRed.hyps(1) by(rule sees_method_is_class')
then have "P,E,h,sh ⊢ INIT D ([D],False) ← C∙⇩sF(map Val v) : T ∧ P ⊢ T ≤ T"
using SCallInitRed WTrtInit[OF SCallInitRed.prems(3)] by clarsimp
then show ?case by(rule exI)
next
case RedSCallNone then show ?case
by(fastforce intro: WTrtThrow[OF WTrtVal] elim!: typeof_NoSuchMethodError
simp: sconf_def hconf_def)
next
case RedSCallNonStatic then show ?case
by(fastforce intro: WTrtThrow[OF WTrtVal] elim!: typeof_IncompatibleClassChangeError
simp: sconf_def hconf_def)
next
case BlockRedNone thus ?case
by(auto simp del:fun_upd_apply)(fastforce simp:sconf_def lconf_def)
next
case (BlockRedSome e h l V sh b e' h' l' sh' b' v T E Te)
have red: "P ⊢ ⟨e,(h,l(V:=None),sh),b⟩ → ⟨e',(h',l',sh'),b'⟩"
and IH: "⋀E T. ⟦P,E ⊢ (h,l(V:=None),sh) √; iconf sh e; P,E,h,sh ⊢ e : T⟧
⟹ ∃T'. P,E,h',sh' ⊢ e' : T' ∧ P ⊢ T' ≤ T"
and Some: "l' V = Some v" and conf: "P,E ⊢ (h,l,sh) √"
and iconf: "iconf sh {V:T; e}"
and wt: "P,E,h,sh ⊢ {V:T; e} : Te" by fact+
obtain Te' where IH': "P,E(V↦T),h',sh' ⊢ e' : Te' ∧ P ⊢ Te' ≤ Te"
using IH conf iconf wt by(fastforce simp:sconf_def lconf_def)
have "P,h' ⊢ l' (:≤) E(V↦T)" using conf wt
by(fastforce intro:red_preserves_lconf[OF red] simp:sconf_def lconf_def)
hence "P,h' ⊢ v :≤ T" using Some by(fastforce simp:lconf_def)
with IH' show ?case
by(fastforce simp:sconf_def conf_def fun_upd_same simp del:fun_upd_apply)
next
case (InitBlockRed e h l V v sh b e' h' l' sh' b' v' T E T')
have red: "P ⊢ ⟨e, (h,l(V↦v),sh),b⟩ → ⟨e',(h',l',sh'),b'⟩"
and IH: "⋀E T. ⟦P,E ⊢ (h,l(V↦v),sh) √; iconf sh e; P,E,h,sh ⊢ e : T⟧
⟹ ∃U. P,E,h',sh' ⊢ e' : U ∧ P ⊢ U ≤ T"
and v': "l' V = Some v'" and conf: "P,E ⊢ (h,l,sh) √"
and iconf: "iconf sh {V:T; V:=Val v;; e}"
and wt: "P,E,h,sh ⊢ {V:T := Val v; e} : T'" by fact+
from wt obtain T⇩1 where wt⇩1: "typeof⇘h⇙ v = Some T⇩1"
and T1subT: "P ⊢ T⇩1 ≤ T" and wt⇩2: "P,E(V↦T),h,sh ⊢ e : T'" by auto
have lconf⇩2: "P,h ⊢ l(V↦v) (:≤) E(V↦T)" using conf wt⇩1 T1subT
by(simp add:sconf_def lconf_upd2 conf_def)
have "∃T⇩1'. typeof⇘h'⇙ v' = Some T⇩1' ∧ P ⊢ T⇩1' ≤ T"
using v' red_preserves_lconf[OF red wt⇩2 lconf⇩2]
by(fastforce simp:lconf_def conf_def)
with IH conf iconf lconf⇩2 wt⇩2 show ?case by (fastforce simp add:sconf_def)
next
case (SeqRed e h l sh b e' h' l' sh' b' e⇩2)
then have val: "val_of e = None" by (simp add: val_no_step)
show ?case
proof(cases "lass_val_of e")
case None
then show ?thesis
using SeqRed val by(auto elim: WTrt_hext_shext_mono[OF _ red_hext_incr red_shext_incr])
next
case (Some a)
have "sh = sh'" using SeqRed lass_val_of_spec[OF Some] by auto
then show ?thesis using SeqRed val Some
by(auto intro: lass_val_of_iconf[OF Some] elim: WTrt_hext_mono[OF _ red_hext_incr])
qed
next
case CondRed thus ?case
by auto (blast intro:WTrt_hext_shext_mono[OF _ red_hext_incr red_shext_incr])+
next
case ThrowRed thus ?case
by(auto simp:is_refT_def)(blast dest:widen_Class[THEN iffD1])+
next
case RedThrowNull thus ?case
by(fastforce intro: WTThrow[OF WTVal] elim!:typeof_NullPointer simp:sconf_def hconf_def)
next
case TryRed thus ?case
by auto (blast intro:widen_trans WTrt_hext_shext_mono[OF _ red_hext_incr red_shext_incr])
next
case RedTryFail thus ?case
by(fastforce intro: WTrtThrow[OF WTrtVal] simp:sconf_def hconf_def)
next
case (ListRed1 e h l sh b e' h' l' sh' b' es)
then have val: "val_of e = None" by(simp add: val_no_step)
obtain U Us where Ts: "Ts = U # Us" using ListRed1 by auto
then have nsub_RI: "¬ sub_RIs es" and wts: "P,E,h,sh ⊢ es [:] Us" and wt: "P,E,h,sh ⊢ e : U"
and IH: "⋀E T. ⟦P,E ⊢ (h, l, sh) √; P,E,h,sh ⊢ e : T⟧ ⟹ ∃T'. P,E,h',sh' ⊢ e' : T' ∧ P ⊢ T' ≤ T"
using ListRed1 val by auto
obtain T' where
"∀E0 E1. (∃T2. P,E1,h',sh' ⊢ e' : T2 ∧ P ⊢ T2 ≤ E0) = (P,E1,h',sh' ⊢ e' : T' E0 E1 ∧ P ⊢ T' E0 E1 ≤ E0)"
by moura
then have disj: "∀E t. ¬ P,E ⊢ (h, l, sh) √ ∨ ¬ P,E,h,sh ⊢ e : t ∨ P,E,h',sh' ⊢ e' : T' t E ∧ P ⊢ T' t E ≤ t"
using IH by presburger
have "P,E,h',sh' ⊢ es [:] Us"
using nsub_RI wts wt by (metis (no_types) ListRed1.hyps(1) WTrts_hext_shext_mono red_hext_incr red_shext_incr)
then have "∃ts. (∃t tsa. ts = t # tsa ∧ P,E,h',sh' ⊢ e' : t ∧ P,E,h',sh' ⊢ es [:] tsa) ∧ P ⊢ ts [≤] (U # Us)"
using disj wt ListRed1.prems(1) by blast
then show ?case using Ts by auto
next
case ListRed2 thus ?case
by(fastforce dest: hext_typeof_mono[OF reds_hext_incr])
next
case (InitNoneRed sh C C' Cs e h l b)
then have sh: "sh ⊴⇩s sh(C ↦ (sblank P C, Prepared))" by(simp add: shext_def)
have wt: "P,E,h,sh(C ↦ (sblank P C, Prepared)) ⊢ INIT C' (C # Cs,False) ← e : T"
using InitNoneRed WTrt_shext_mono[OF _ sh] by fastforce
then show ?case by(rule_tac x = T in exI) (simp add: fun_upd_def)
next
case (RedInitDone sh C sfs C' Cs e h l b)
then have "P,E,h,sh ⊢ INIT C' (Cs,True) ← e : T" by auto (metis Nil_tl list.set_sel(2))
then show ?case by(rule_tac x = T in exI) simp
next
case (RedInitProcessing sh C sfs C' Cs e h l b)
then have "P,E,h,sh ⊢ INIT C' (Cs,True) ← e : T" by auto (metis Nil_tl list.set_sel(2))+
then show ?case by(rule_tac x = T in exI) simp
next
case RedInitError then show ?case
by(fastforce intro: WTrtThrow[OF WTrtVal] elim!: typeof_NoClassDefFoundError
simp: sconf_def hconf_def)
next
case (InitObjectRed sh C sfs sh' C' Cs e h l b)
then have sh: "sh ⊴⇩s sh(Object ↦ (sfs, Processing))" by(simp add: shext_def)
have "P,E,h,sh' ⊢ INIT C' (C # Cs,True) ← e : T"
using InitObjectRed WTrt_shext_mono[OF _ sh] by auto
then show ?case by(rule_tac x = T in exI) (simp add: fun_upd_def)
next
case (InitNonObjectSuperRed sh C sfs D fs ms sh' C' Cs e h l b)
then have sh: "sh ⊴⇩s sh(C ↦ (sfs, Processing))" by(simp add: shext_def)
then have cd: "is_class P D" using InitNonObjectSuperRed class_wf wf wf_cdecl_supD by blast
have sup': "supercls_lst P (C # Cs)" using InitNonObjectSuperRed.prems(3) by auto
then have sup: "supercls_lst P (D # C # Cs)"
using supercls_lst_app[of P C Cs D] subcls1I[OF InitNonObjectSuperRed.hyps(3,2)] by auto
have "distinct (C # Cs)" using InitNonObjectSuperRed.prems(3) by auto
then have dist: "distinct (D # C # Cs)"
using wf_supercls_distinct_app[OF wf InitNonObjectSuperRed.hyps(2-3) sup'] by simp
have "P,E,h,sh' ⊢ INIT C' (D # C # Cs,False) ← e : T"
using InitNonObjectSuperRed WTrt_shext_mono[OF _ sh] cd sup dist by auto
then show ?case by(rule_tac x = T in exI) simp
next
case (RedInitRInit C' C Cs e' h l sh b E T)
then obtain a sfs where C: "class P C = ⌊a⌋" and proc: "sh C = ⌊(sfs, Processing)⌋"
using WTrtInit by(auto simp: is_class_def)
then have T': "P,E,h,sh ⊢ C∙⇩sclinit([]) : Void" using wf_types_clinit[OF wf C] by simp
have "P,E,h,sh ⊢ RI (C,C∙⇩sclinit([])) ; Cs ← e' : T"
using RedInitRInit by(auto intro: T')
then show ?case by(rule_tac x = T in exI) simp
next
case (RInitRed e h l sh b e' h' l' sh' b' C Cs e⇩0 E T)
then have "(⋀E T. P,E ⊢ (h, l, sh) √ ⟹ P,E,h,sh ⊢ e : T ⟹ ∃T'. P,E,h',sh' ⊢ e' : T' ∧ P ⊢ T' ≤ T)"
by auto
then have "∃T'. P,E,h',sh' ⊢ e' : T'" using RInitRed by blast
then obtain T' where e': "P,E,h',sh' ⊢ e' : T'" by auto
have wt⇩0: "P,E,h',sh' ⊢ e⇩0 : T"
using RInitRed by simp (auto intro: WTrt_hext_shext_mono[OF _ red_hext_incr red_shext_incr])
have nip: "∀C' ∈ set (C#Cs). not_init C' e' ∧ (∃sfs. sh' C' = ⌊(sfs, Processing)⌋)"
using RInitRed red_proc_pres[OF wf_prog_wwf_prog[OF wf]] by auto
have shC: "∃sfs. sh' C = ⌊(sfs, Processing)⌋ ∨ sh' C = ⌊(sfs, Error)⌋ ∧ e' = THROW NoClassDefFoundError"
using RInitRed red_proc_pres[OF wf_prog_wwf_prog[OF wf] RInitRed.hyps(1)] by blast
have "P,E,h',sh' ⊢ RI (C,e') ; Cs ← e⇩0 : T" using RInitRed e' wt⇩0 nip shC by auto
then show ?case by(rule_tac x = T in exI) simp
next
case (RedRInit sh C sfs i sh' C' Cs v e h l b)
then have sh: "sh ⊴⇩s sh(C ↦ (sfs, Done))" by(auto simp: shext_def)
have wt: "P,E,h,sh(C ↦ (sfs, Done)) ⊢ e : T"
using RedRInit WTrt_shext_mono[OF _ sh] by auto
have shC: "∀C' ∈ set(tl Cs). ∃sfs. sh C' = ⌊(sfs, Processing)⌋" using RedRInit by(cases Cs, auto)
have "P,E,h,sh' ⊢ INIT C' (Cs,True) ← e : T" using RedRInit wt shC by(cases Cs, auto)
then show ?case by(rule_tac x = T in exI) simp
next
case (SCallThrowParams es vs e es' C M h l sh b)
then show ?case using map_Val_nthrow_neq[of _ vs e es'] by fastforce
next
case (RInitInitThrow sh C sfs i sh' a D Cs e h l b)
then have sh: "sh ⊴⇩s sh(C ↦ (sfs, Error))" by(auto simp: shext_def)
have wt: "P,E,h,sh(C ↦ (sfs, Error)) ⊢ e : T"
using RInitInitThrow WTrt_shext_mono[OF _ sh] by clarsimp
then have "P,E,h,sh' ⊢ RI (D,Throw a) ; Cs ← e : T" using RInitInitThrow by auto
then show ?case by(rule_tac x = T in exI) simp
qed fastforce+
corollary subject_reduction:
"⟦ wf_J_prog P; P ⊢ ⟨e,s,b⟩ → ⟨e',s',b'⟩; P,E ⊢ s √; iconf (shp s) e; P,E,hp s,shp s ⊢ e:T ⟧
⟹ ∃T'. P,E,hp s',shp s' ⊢ e':T' ∧ P ⊢ T' ≤ T"
by(cases s, cases s', fastforce dest:subject_reduction2)
corollary subjects_reduction:
"⟦ wf_J_prog P; P ⊢ ⟨es,s,b⟩ [→] ⟨es',s',b'⟩; P,E ⊢ s √; iconfs (shp s) es; P,E,hp s,shp s ⊢ es[:]Ts ⟧
⟹ ∃Ts'. P,E,hp s',shp s' ⊢ es'[:]Ts' ∧ P ⊢ Ts' [≤] Ts"
by(cases s, cases s', fastforce dest:subjects_reduction2)
subsection ‹ Lifting to @{text"→*"} ›
text‹ Now all these preservation lemmas are first lifted to the transitive
closure \dots ›
lemma Red_preserves_sconf:
assumes wf: "wf_J_prog P" and Red: "P ⊢ ⟨e,s,b⟩ →* ⟨e',s',b'⟩"
shows "⋀T. ⟦ P,E,hp s,shp s ⊢ e : T; iconf (shp s) e; P,E ⊢ s √ ⟧ ⟹ P,E ⊢ s' √"
using Red
proof (induct rule:converse_rtrancl_induct3)
case refl show ?case by fact
next
case (step e s b e' s' b')
obtain h l sh h' l' sh' where s:"s = (h,l,sh)" and s':"s' = (h',l',sh')"
by(cases s, cases s')
then have "P ⊢ ⟨e,(h,l,sh),b⟩ → ⟨e',(h',l',sh'),b'⟩" using step.hyps(1) by simp
then have iconf': "iconf (shp s') e'" using red_preserves_iconf[OF wf_prog_wwf_prog[OF wf]]
step.prems(2) s s' by simp
thus ?case using step
by(blast intro:red_preserves_sconf dest: subject_reduction[OF wf])
qed
lemma Red_preserves_iconf:
assumes wf: "wwf_J_prog P" and Red: "P ⊢ ⟨e,s,b⟩ →* ⟨e',s',b'⟩"
shows "iconf (shp s) e ⟹ iconf (shp s') e'"
using Red
proof (induct rule:converse_rtrancl_induct3)
case refl show ?case by fact
next
case (step e s b e' s' b')
thus ?case using wf step by(cases s, cases s', simp) (blast intro:red_preserves_iconf)
qed
lemma Reds_preserves_iconf:
assumes wf: "wwf_J_prog P" and Red: "P ⊢ ⟨es,s,b⟩ [→]* ⟨es',s',b'⟩"
shows "iconfs (shp s) es ⟹ iconfs (shp s') es'"
using Red
proof (induct rule:converse_rtrancl_induct3)
case refl show ?case by fact
next
case (step e s b e' s' b')
thus ?case using wf step by(cases s, cases s', simp) (blast intro:reds_preserves_iconf)
qed
lemma Red_preserves_bconf:
assumes wf: "wwf_J_prog P" and Red: "P ⊢ ⟨e,s,b⟩ →* ⟨e',s',b'⟩"
shows "iconf (shp s) e ⟹ P,(shp s) ⊢⇩b (e,b) √ ⟹ P,(shp s') ⊢⇩b (e'::expr,b') √"
using Red
proof (induct rule:converse_rtrancl_induct3)
case refl show ?case by fact
next
case (step e s1 b e' s2 b')
then have "iconf (shp s2) e'" using step red_preserves_iconf[OF wf]
by(cases s1, cases s2) auto
thus ?case using step by(cases s1, cases s2, simp) (blast intro:red_preserves_bconf)
qed
lemma Reds_preserves_bconf:
assumes wf: "wwf_J_prog P" and Red: "P ⊢ ⟨es,s,b⟩ [→]* ⟨es',s',b'⟩"
shows "iconfs (shp s) es ⟹ P,(shp s) ⊢⇩b (es,b) √ ⟹ P,(shp s') ⊢⇩b (es'::expr list,b') √"
using Red
proof (induct rule:converse_rtrancl_induct3)
case refl show ?case by fact
next
case (step es s1 b es' s2 b')
then have "iconfs (shp s2) es'" using step reds_preserves_iconf[OF wf]
by(cases s1, cases s2) auto
thus ?case using step by(cases s1, cases s2, simp) (blast intro:reds_preserves_bconf)
qed
lemma Red_preserves_defass:
assumes wf: "wf_J_prog P" and reds: "P ⊢ ⟨e,s,b⟩ →* ⟨e',s',b'⟩"
shows "𝒟 e ⌊dom(lcl s)⌋ ⟹ 𝒟 e' ⌊dom(lcl s')⌋"
using reds
proof (induct rule:converse_rtrancl_induct3)
case refl thus ?case .
next
case (step e s b e' s' b') thus ?case
by(cases s,cases s')(auto dest:red_preserves_defass[OF wf])
qed
lemma Red_preserves_type:
assumes wf: "wf_J_prog P" and Red: "P ⊢ ⟨e,s,b⟩ →* ⟨e',s',b'⟩"
shows "!!T. ⟦ P,E ⊢ s√; iconf (shp s) e; P,E,hp s,shp s ⊢ e:T ⟧
⟹ ∃T'. P ⊢ T' ≤ T ∧ P,E,hp s',shp s' ⊢ e':T'"
using Red
proof (induct rule:converse_rtrancl_induct3)
case refl thus ?case by blast
next
case step thus ?case
by(blast intro:widen_trans red_preserves_sconf Red_preserves_iconf[OF wf_prog_wwf_prog[OF wf]]
dest:subject_reduction[OF wf])
qed
subsection "The final polish"
text‹ The above preservation lemmas are now combined and packed nicely. ›
definition wf_config :: "J_prog ⇒ env ⇒ state ⇒ expr ⇒ ty ⇒ bool" ("_,_,_ ⊢ _ : _ √" [51,0,0,0,0]50)
where
"P,E,s ⊢ e:T √ ≡ P,E ⊢ s √ ∧ iconf (shp s) e ∧ P,E,hp s,shp s ⊢ e:T"
theorem Subject_reduction: assumes wf: "wf_J_prog P"
shows "P ⊢ ⟨e,s,b⟩ → ⟨e',s',b'⟩ ⟹ P,E,s ⊢ e : T √
⟹ ∃T'. P,E,s' ⊢ e' : T' √ ∧ P ⊢ T' ≤ T"
by(cases s, cases s')
(force simp: wf_config_def
elim:red_preserves_sconf red_preserves_iconf[OF wf_prog_wwf_prog[OF wf]]
dest:subject_reduction[OF wf])
theorem Subject_reductions:
assumes wf: "wf_J_prog P" and reds: "P ⊢ ⟨e,s,b⟩ →* ⟨e',s',b'⟩"
shows "⋀T. P,E,s ⊢ e:T √ ⟹ ∃T'. P,E,s' ⊢ e':T' √ ∧ P ⊢ T' ≤ T"
using reds
proof (induct rule:converse_rtrancl_induct3)
case refl thus ?case by blast
next
case step thus ?case
by(blast dest:Subject_reduction[OF wf] intro:widen_trans)
qed
corollary Progress: assumes wf: "wf_J_prog P"
shows "⟦ P,E,s ⊢ e : T √; 𝒟 e ⌊dom(lcl s)⌋; P,shp s ⊢⇩b (e,b) √; ¬ final e ⟧
⟹ ∃e' s' b'. P ⊢ ⟨e,s,b⟩ → ⟨e',s',b'⟩"
using progress[OF wf_prog_wwf_prog[OF wf]]
by(cases b) (auto simp:wf_config_def sconf_def)
corollary TypeSafety:
"⟦ wf_J_prog P; P,E ⊢ s √; P,E ⊢ e::T; 𝒟 e ⌊dom(lcl s)⌋;
iconf (shp s) e; P,(shp s) ⊢⇩b (e,b) √;
P ⊢ ⟨e,s,b⟩ →* ⟨e',s',b'⟩; ¬(∃e'' s'' b''. P ⊢ ⟨e',s',b'⟩ → ⟨e'',s'',b''⟩) ⟧
⟹ (∃v. e' = Val v ∧ P,hp s' ⊢ v :≤ T) ∨
(∃a. e' = Throw a ∧ a ∈ dom(hp s'))"
apply(subgoal_tac "wwf_J_prog P")
prefer 2 apply(rule wf_prog_wwf_prog, simp)
apply(subgoal_tac " P,E,s ⊢ e:T √")
prefer 2
apply(fastforce simp:wf_config_def dest:WT_implies_WTrt)
apply(frule (2) Subject_reductions)
apply(erule exE conjE)+
apply(frule (2) Red_preserves_defass)
apply(frule (3) Red_preserves_bconf)
apply(subgoal_tac "final e'")
prefer 2
apply(blast dest: Progress)
apply (fastforce simp:wf_config_def final_def conf_def dest: Progress)
done
end
Theory Equivalence
section ‹ Equivalence of Big Step and Small Step Semantics ›
theory Equivalence imports TypeSafe WWellForm begin
subsection‹Small steps simulate big step›
subsubsection "Init"
text "The reduction of initialization expressions doesn't touch or use
their on-hold expressions (the subexpression to the right of @{text ←})
until the initialization operation completes. This function is used to prove
this and related properties. It is then used for general reduction of
initialization expressions separately from their on-hold expressions by
using the on-hold expression @{term unit}, then putting the real on-hold
expression back in at the end."
fun init_switch :: "'a exp ⇒ 'a exp ⇒ 'a exp" where
"init_switch (INIT C (Cs,b) ← e⇩i) e = (INIT C (Cs,b) ← e)" |
"init_switch (RI(C,e');Cs ← e⇩i) e = (RI(C,e');Cs ← e)" |
"init_switch e' e = e'"
fun INIT_class :: "'a exp ⇒ cname option" where
"INIT_class (INIT C (Cs,b) ← e) = (if C = last (C#Cs) then Some C else None)" |
"INIT_class (RI(C,e⇩0);Cs ← e) = Some (last (C#Cs))" |
"INIT_class _ = None"
lemma init_red_init:
"⟦ init_exp_of e⇩0 = ⌊e⌋; P ⊢ ⟨e⇩0,s⇩0,b⇩0⟩ → ⟨e⇩1,s⇩1,b⇩1⟩ ⟧
⟹ (init_exp_of e⇩1 = ⌊e⌋ ∧ (INIT_class e⇩0 = ⌊C⌋ ⟶ INIT_class e⇩1 = ⌊C⌋))
∨ (e⇩1 = e ∧ b⇩1 = icheck P (the(INIT_class e⇩0)) e) ∨ (∃a. e⇩1 = throw a)"
by(erule red.cases, auto)
lemma init_exp_switch[simp]:
"init_exp_of e⇩0 = ⌊e⌋ ⟹ init_exp_of (init_switch e⇩0 e') = ⌊e'⌋"
by(cases e⇩0, simp_all)
lemma init_red_sync:
"⟦ P ⊢ ⟨e⇩0,s⇩0,b⇩0⟩ → ⟨e⇩1,s⇩1,b⇩1⟩; init_exp_of e⇩0 = ⌊e⌋; e⇩1 ≠ e ⟧
⟹ (⋀e'. P ⊢ ⟨init_switch e⇩0 e',s⇩0,b⇩0⟩ → ⟨init_switch e⇩1 e',s⇩1,b⇩1⟩)"
proof(induct rule: red.cases) qed(simp_all add: red_reds.intros)
lemma init_red_sync_end:
"⟦ P ⊢ ⟨e⇩0,s⇩0,b⇩0⟩ → ⟨e⇩1,s⇩1,b⇩1⟩; init_exp_of e⇩0 = ⌊e⌋; e⇩1 = e; throw_of e = None ⟧
⟹ (⋀e'. ¬sub_RI e' ⟹ P ⊢ ⟨init_switch e⇩0 e',s⇩0,b⇩0⟩ → ⟨e',s⇩1,icheck P (the(INIT_class e⇩0)) e'⟩)"
proof(induct rule: red.cases) qed(simp_all add: red_reds.intros)
lemma init_reds_sync_unit':
"⟦ P ⊢ ⟨e⇩0,s⇩0,b⇩0⟩ →* ⟨Val v',s⇩1,b⇩1⟩; init_exp_of e⇩0 = ⌊unit⌋; INIT_class e⇩0 = ⌊C⌋ ⟧
⟹ (⋀e'. ¬sub_RI e' ⟹ P ⊢ ⟨init_switch e⇩0 e',s⇩0,b⇩0⟩ →* ⟨e',s⇩1,icheck P (the(INIT_class e⇩0)) e'⟩)"
proof(induct rule:converse_rtrancl_induct3)
case refl then show ?case by simp
next
case (step e0 s0 b0 e1 s1 b1)
have "(init_exp_of e1 = ⌊unit⌋ ∧ (INIT_class e0 = ⌊C⌋ ⟶ INIT_class e1 = ⌊C⌋))
∨ (e1 = unit ∧ b1 = icheck P (the(INIT_class e0)) unit) ∨ (∃a. e1 = throw a)"
using init_red_init[OF step.prems(1) step.hyps(1)] by simp
then show ?case
proof(rule disjE)
assume assm: "init_exp_of e1 = ⌊unit⌋ ∧ (INIT_class e0 = ⌊C⌋ ⟶ INIT_class e1 = ⌊C⌋)"
then have red: "P ⊢ ⟨init_switch e0 e',s0,b0⟩ → ⟨init_switch e1 e',s1,b1⟩"
using init_red_sync[OF step.hyps(1) step.prems(1)] by simp
have reds: "P ⊢ ⟨init_switch e1 e',s1,b1⟩ →* ⟨e',s⇩1,icheck P (the (INIT_class e0)) e'⟩"
using step.hyps(3)[OF _ _ step.prems(3)] assm step.prems(2) by simp
show ?thesis by(rule converse_rtrancl_into_rtrancl[OF red reds])
next
assume "(e1 = unit ∧ b1 = icheck P (the(INIT_class e0)) unit) ∨ (∃a. e1 = throw a)"
then show ?thesis
proof(rule disjE)
assume assm: "e1 = unit ∧ b1 = icheck P (the(INIT_class e0)) unit" then have e1: "e1 = unit" by simp
have sb: "s1 = s⇩1" "b1 = b⇩1" using reds_final_same[OF step.hyps(2)] assm
by(simp_all add: final_def)
then have step': "P ⊢ ⟨init_switch e0 e',s0,b0⟩ → ⟨e',s⇩1,icheck P (the (INIT_class e0)) e'⟩"
using init_red_sync_end[OF step.hyps(1) step.prems(1) e1 _ step.prems(3)] by auto
then have "P ⊢ ⟨init_switch e0 e',s0,b0⟩ →* ⟨e',s⇩1,icheck P (the (INIT_class e0)) e'⟩"
using r_into_rtrancl by auto
then show ?thesis using step assm sb by simp
next
assume "∃a. e1 = throw a" then obtain a where "e1 = throw a" by clarsimp
then have tof: "throw_of e1 = ⌊a⌋" by simp
then show ?thesis using reds_throw[OF step.hyps(2) tof] by simp
qed
qed
qed
lemma init_reds_sync_unit_throw':
"⟦ P ⊢ ⟨e⇩0,s⇩0,b⇩0⟩ →* ⟨throw a,s⇩1,b⇩1⟩; init_exp_of e⇩0 = ⌊unit⌋ ⟧
⟹ (⋀e'. P ⊢ ⟨init_switch e⇩0 e',s⇩0,b⇩0⟩ →* ⟨throw a,s⇩1,b⇩1⟩)"
proof(induct rule:converse_rtrancl_induct3)
case refl then show ?case by simp
next
case (step e0 s0 b0 e1 s1 b1)
have "init_exp_of e1 = ⌊unit⌋ ∧ (∀C. INIT_class e0 = ⌊C⌋ ⟶ INIT_class e1 = ⌊C⌋) ∨
e1 = unit ∧ b1 = icheck P (the (INIT_class e0)) unit ∨ (∃a. e1 = throw a)"
using init_red_init[OF step.prems(1) step.hyps(1)] by auto
then show ?case
proof(rule disjE)
assume assm: "init_exp_of e1 = ⌊unit⌋ ∧ (∀C. INIT_class e0 = ⌊C⌋ ⟶ INIT_class e1 = ⌊C⌋)"
then have "P ⊢ ⟨init_switch e0 e',s0,b0⟩ → ⟨init_switch e1 e',s1,b1⟩"
using step init_red_sync[OF step.hyps(1) step.prems] by simp
then show ?thesis using step assm by (meson converse_rtrancl_into_rtrancl)
next
assume "e1 = unit ∧ b1 = icheck P (the (INIT_class e0)) unit ∨ (∃a. e1 = throw a)"
then show ?thesis
proof(rule disjE)
assume "e1 = unit ∧ b1 = icheck P (the (INIT_class e0)) unit"
then show ?thesis using step using final_def reds_final_same by blast
next
assume assm: "∃a. e1 = throw a"
then have "P ⊢ ⟨init_switch e0 e',s0,b0⟩ → ⟨e1,s1,b1⟩"
using init_red_sync[OF step.hyps(1) step.prems] by clarsimp
then show ?thesis using step by simp
qed
qed
qed
lemma init_reds_sync_unit:
assumes "P ⊢ ⟨e⇩0,s⇩0,b⇩0⟩ →* ⟨Val v',s⇩1,b⇩1⟩" and "init_exp_of e⇩0 = ⌊unit⌋" and "INIT_class e⇩0 = ⌊C⌋"
and "¬sub_RI e'"
shows "P ⊢ ⟨init_switch e⇩0 e',s⇩0,b⇩0⟩ →* ⟨e',s⇩1,icheck P (the(INIT_class e⇩0)) e'⟩"
using init_reds_sync_unit'[OF assms] by clarsimp
lemma init_reds_sync_unit_throw:
assumes "P ⊢ ⟨e⇩0,s⇩0,b⇩0⟩ →* ⟨throw a,s⇩1,b⇩1⟩" and "init_exp_of e⇩0 = ⌊unit⌋"
shows "P ⊢ ⟨init_switch e⇩0 e',s⇩0,b⇩0⟩ →* ⟨throw a,s⇩1,b⇩1⟩"
using init_reds_sync_unit_throw'[OF assms] by clarsimp
lemma InitSeqReds:
assumes "P ⊢ ⟨INIT C ([C],b) ← unit,s⇩0,b⇩0⟩ →* ⟨Val v',s⇩1,b⇩1⟩"
and "P ⊢ ⟨e,s⇩1,icheck P C e⟩ →* ⟨e⇩2,s⇩2,b⇩2⟩" and "¬sub_RI e"
shows "P ⊢ ⟨INIT C ([C],b) ← e,s⇩0,b⇩0⟩ →* ⟨e⇩2,s⇩2,b⇩2⟩"
using assms
proof -
have "P ⊢ ⟨init_switch (INIT C ([C],b) ← unit) e,s⇩0,b⇩0⟩ →* ⟨e,s⇩1,icheck P C e⟩"
using init_reds_sync_unit[OF assms(1) _ _ assms(3)] by simp
then show ?thesis using assms(2) by simp
qed
lemma InitSeqThrowReds:
assumes "P ⊢ ⟨INIT C ([C],b) ← unit,s⇩0,b⇩0⟩ →* ⟨throw a,s⇩1,b⇩1⟩"
shows "P ⊢ ⟨INIT C ([C],b) ← e,s⇩0,b⇩0⟩ →* ⟨throw a,s⇩1,b⇩1⟩"
using assms
proof -
have "P ⊢ ⟨init_switch (INIT C ([C],b) ← unit) e,s⇩0,b⇩0⟩ →* ⟨throw a,s⇩1,b⇩1⟩"
using init_reds_sync_unit_throw[OF assms(1)] by simp
then show ?thesis by simp
qed
lemma InitNoneReds:
"⟦ sh C = None;
P ⊢ ⟨INIT C' (C # Cs,False) ← e,(h, l, sh(C ↦ (sblank P C, Prepared))),b⟩ →* ⟨e',s',b'⟩ ⟧
⟹ P ⊢ ⟨INIT C' (C#Cs,False) ← e,(h,l,sh),b⟩ →* ⟨e',s',b'⟩"
apply(rule converse_rtrancl_into_rtrancl)
apply(erule InitNoneRed)
apply assumption
done
lemma InitDoneReds:
"⟦ sh C = Some(sfs,Done); P ⊢ ⟨INIT C' (Cs,True) ← e,(h,l,sh),b⟩ →* ⟨e',s',b'⟩ ⟧
⟹ P ⊢ ⟨INIT C' (C#Cs,False) ← e,(h,l,sh),b⟩ →* ⟨e',s',b'⟩"
apply(rule converse_rtrancl_into_rtrancl)
apply(erule RedInitDone)
apply assumption
done
lemma InitProcessingReds:
"⟦ sh C = Some(sfs,Processing); P ⊢ ⟨INIT C' (Cs,True) ← e,(h,l,sh),b⟩ →* ⟨e',s',b'⟩ ⟧
⟹ P ⊢ ⟨INIT C' (C#Cs,False) ← e,(h,l,sh),b⟩ →* ⟨e',s',b'⟩"
apply(rule converse_rtrancl_into_rtrancl)
apply(erule RedInitProcessing)
apply assumption
done
lemma InitErrorReds:
"⟦ sh C = Some(sfs,Error); P ⊢ ⟨RI (C,THROW NoClassDefFoundError);Cs ← e,(h,l,sh),b⟩ →* ⟨e',s',b'⟩ ⟧
⟹ P ⊢ ⟨INIT C' (C#Cs,False) ← e,(h,l,sh),b⟩ →* ⟨e',s',b'⟩"
apply(rule converse_rtrancl_into_rtrancl)
apply(erule RedInitError)
apply assumption
done
lemma InitObjectReds:
"⟦ sh C = Some(sfs,Prepared); C = Object; sh' = sh(C ↦ (sfs,Processing));
P ⊢ ⟨INIT C' (C#Cs,True) ← e,(h,l,sh'),b⟩ →* ⟨e',s',b'⟩ ⟧
⟹ P ⊢ ⟨INIT C' (C#Cs,False) ← e,(h,l,sh),b⟩ →* ⟨e',s',b'⟩"
apply(rule converse_rtrancl_into_rtrancl)
apply(erule (2) InitObjectRed)
apply assumption
done
lemma InitNonObjectReds:
"⟦ sh C = Some(sfs,Prepared); C ≠ Object; class P C = Some (D,r);
sh' = sh(C ↦ (sfs,Processing));
P ⊢ ⟨INIT C' (D#C#Cs,False) ← e,(h,l,sh'),b⟩ →* ⟨e',s',b'⟩ ⟧
⟹ P ⊢ ⟨INIT C' (C#Cs,False) ← e,(h,l,sh),b⟩ →* ⟨e',s',b'⟩"
apply(rule converse_rtrancl_into_rtrancl)
apply(erule (3) InitNonObjectSuperRed)
apply assumption
done
lemma RedsInitRInit:
"P ⊢ ⟨RI (C,C∙⇩sclinit([]));Cs ← e,(h,l,sh),b⟩ →* ⟨e',s',b'⟩
⟹ P ⊢ ⟨INIT C' (C#Cs,True) ← e,(h,l,sh),b⟩ →* ⟨e',s',b'⟩"
apply(rule converse_rtrancl_into_rtrancl)
apply(rule RedInitRInit)
apply assumption
done
lemmas rtrancl_induct3 =
rtrancl_induct[of "(ax,ay,az)" "(bx,by,bz)", split_format (complete), consumes 1, case_names refl step]
lemma RInitReds:
"P ⊢ ⟨e,s,b⟩ →* ⟨e',s',b'⟩
⟹ P ⊢ ⟨RI (C,e);Cs ← e⇩0, s, b⟩ →* ⟨RI (C,e');Cs ← e⇩0, s', b'⟩"
apply(erule rtrancl_induct3)
apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule RInitRed)
done
lemma RedsRInit:
"⟦ P ⊢ ⟨e⇩0,s⇩0,b⇩0⟩ →* ⟨Val v,(h⇩1,l⇩1,sh⇩1),b⇩1⟩;
sh⇩1 C = Some (sfs, i); sh⇩2 = sh⇩1(C ↦ (sfs,Done)); C' = last(C#Cs);
P ⊢ ⟨INIT C' (Cs,True) ← e,(h⇩1,l⇩1,sh⇩2),b⇩1⟩ →* ⟨e',s',b'⟩ ⟧
⟹ P ⊢ ⟨RI (C, e⇩0);Cs ← e,s⇩0,b⇩0⟩ →* ⟨e',s',b'⟩"
apply(rule rtrancl_trans)
apply(erule RInitReds)
apply(rule converse_rtrancl_into_rtrancl)
apply(erule (2) RedRInit)
apply assumption
done
lemma RInitInitThrowReds:
"⟦ P ⊢ ⟨e,s,b⟩ →* ⟨Throw a, (h',l',sh'),b'⟩;
sh' C = Some(sfs, i); sh'' = sh'(C ↦ (sfs, Error));
P ⊢ ⟨RI (D,Throw a);Cs ← e⇩0, (h',l',sh''),b'⟩ →* ⟨e⇩1,s⇩1,b⇩1⟩ ⟧
⟹ P ⊢ ⟨RI (C,e);D#Cs ← e⇩0,s,b⟩ →* ⟨e⇩1,s⇩1,b⇩1⟩"
apply(rule rtrancl_trans)
apply(erule RInitReds)
apply(rule converse_rtrancl_into_rtrancl)
apply(erule (1) RInitInitThrow)
apply assumption
done
lemma RInitThrowReds:
"⟦ P ⊢ ⟨e,s,b⟩ →* ⟨Throw a, (h',l',sh'),b'⟩;
sh' C = Some(sfs, i); sh'' = sh'(C ↦ (sfs, Error)) ⟧
⟹ P ⊢ ⟨RI (C,e);Nil ← e⇩0,s,b⟩ →* ⟨Throw a, (h',l',sh''),b'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule RInitReds)
apply(erule RInitThrow)
apply assumption
done
subsubsection "New"
lemma NewInitDoneReds:
"⟦ sh C = Some (sfs, Done); new_Addr h = Some a;
P ⊢ C has_fields FDTs; h' = h(a↦blank P C) ⟧
⟹ P ⊢ ⟨new C,(h,l,sh),False⟩ →* ⟨addr a,(h',l,sh),False⟩"
apply(rule converse_rtrancl_into_rtrancl)
apply(erule NewInitDoneRed)
apply(rule r_into_rtrancl)
apply(erule (2) RedNew)
done
lemma NewInitDoneReds2:
"⟦ sh C = Some (sfs, Done); new_Addr h = None; is_class P C ⟧
⟹ P ⊢ ⟨new C,(h,l,sh),False⟩ →* ⟨THROW OutOfMemory, (h,l,sh), False⟩"
apply(rule_tac converse_rtrancl_into_rtrancl)
apply(erule NewInitDoneRed)
apply(rule r_into_rtrancl)
apply(erule (1) RedNewFail)
done
lemma NewInitReds:
"⟦ ∄sfs. shp s C = Some (sfs, Done);
P ⊢ ⟨INIT C ([C],False) ← unit,s,False⟩ →* ⟨Val v',(h',l',sh'),b'⟩;
new_Addr h' = Some a; P ⊢ C has_fields FDTs; h'' = h'(a↦blank P C); is_class P C ⟧
⟹ P ⊢ ⟨new C,s,False⟩ →* ⟨addr a,(h'',l',sh'),False⟩"
apply(rule_tac b = "(INIT C ([C],False) ← new C,s,False)" in converse_rtrancl_into_rtrancl)
apply(cases s, simp)
apply (simp add: NewInitRed)
apply(erule InitSeqReds, simp_all)
apply(rule r_into_rtrancl, rule RedNew)
apply simp+
done
lemma NewInitOOMReds:
"⟦ ∄sfs. shp s C = Some (sfs, Done);
P ⊢ ⟨INIT C ([C],False) ← unit,s,False⟩ →* ⟨Val v',(h',l',sh'),b'⟩;
new_Addr h' = None; is_class P C ⟧
⟹ P ⊢ ⟨new C,s,False⟩ →* ⟨THROW OutOfMemory,(h',l',sh'),False⟩"
apply(rule_tac b = "(INIT C ([C],False) ← new C,s,False)" in converse_rtrancl_into_rtrancl)
apply(cases s, simp)
apply (simp add: NewInitRed)
apply(erule InitSeqReds, simp_all)
apply(rule r_into_rtrancl, rule RedNewFail)
apply simp+
done
lemma NewInitThrowReds:
"⟦ ∄sfs. shp s C = Some (sfs, Done); is_class P C;
P ⊢ ⟨INIT C ([C],False) ← unit,s,False⟩ →* ⟨throw a,s',b'⟩ ⟧
⟹ P ⊢ ⟨new C,s,False⟩ →* ⟨throw a,s',b'⟩"
apply(rule_tac b = "(INIT C ([C],False) ← new C,s,False)" in converse_rtrancl_into_rtrancl)
apply(cases s, simp)
apply (simp add: NewInitRed)
apply(erule InitSeqThrowReds)
done
subsubsection "Cast"
lemma CastReds:
"P ⊢ ⟨e,s,b⟩ →* ⟨e',s',b'⟩ ⟹ P ⊢ ⟨Cast C e,s,b⟩ →* ⟨Cast C e',s',b'⟩"
apply(erule rtrancl_induct3)
apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule CastRed)
done
lemma CastRedsNull:
"P ⊢ ⟨e,s,b⟩ →* ⟨null,s',b'⟩ ⟹ P ⊢ ⟨Cast C e,s,b⟩ →* ⟨null,s',b'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule CastReds)
apply(rule RedCastNull)
done
lemma CastRedsAddr:
"⟦ P ⊢ ⟨e,s,b⟩ →* ⟨addr a,s',b'⟩; hp s' a = Some(D,fs); P ⊢ D ≼⇧* C ⟧ ⟹
P ⊢ ⟨Cast C e,s,b⟩ →* ⟨addr a,s',b'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule CastReds)
apply(cases s',simp)
apply(erule (1) RedCast)
done
lemma CastRedsFail:
"⟦ P ⊢ ⟨e,s,b⟩ →* ⟨addr a,s',b'⟩; hp s' a = Some(D,fs); ¬ P ⊢ D ≼⇧* C ⟧ ⟹
P ⊢ ⟨Cast C e,s,b⟩ →* ⟨THROW ClassCast,s',b'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule CastReds)
apply(cases s',simp)
apply(erule (1) RedCastFail)
done
lemma CastRedsThrow:
"⟦ P ⊢ ⟨e,s,b⟩ →* ⟨throw a,s',b'⟩ ⟧ ⟹ P ⊢ ⟨Cast C e,s,b⟩ →* ⟨throw a,s',b'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule CastReds)
apply(rule red_reds.CastThrow)
done
subsubsection "LAss"
lemma LAssReds:
"P ⊢ ⟨e,s,b⟩ →* ⟨e',s',b'⟩ ⟹ P ⊢ ⟨ V:=e,s,b⟩ →* ⟨ V:=e',s',b'⟩"
apply(erule rtrancl_induct3)
apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule LAssRed)
done
lemma LAssRedsVal:
"⟦ P ⊢ ⟨e,s,b⟩ →* ⟨Val v,(h',l',sh'),b'⟩ ⟧ ⟹ P ⊢ ⟨ V:=e,s,b⟩ →* ⟨unit,(h',l'(V↦v),sh'),b'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule LAssReds)
apply(rule RedLAss)
done
lemma LAssRedsThrow:
"⟦ P ⊢ ⟨e,s,b⟩ →* ⟨throw a,s',b'⟩ ⟧ ⟹ P ⊢ ⟨ V:=e,s,b⟩ →* ⟨throw a,s',b'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule LAssReds)
apply(rule red_reds.LAssThrow)
done
subsubsection "BinOp"
lemma BinOp1Reds:
"P ⊢ ⟨e,s,b⟩ →* ⟨e',s',b'⟩ ⟹ P ⊢ ⟨ e «bop» e⇩2, s,b⟩ →* ⟨e' «bop» e⇩2, s',b'⟩"
apply(erule rtrancl_induct3)
apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule BinOpRed1)
done
lemma BinOp2Reds:
"P ⊢ ⟨e,s,b⟩ →* ⟨e',s',b'⟩ ⟹ P ⊢ ⟨(Val v) «bop» e, s,b⟩ →* ⟨(Val v) «bop» e', s',b'⟩"
apply(erule rtrancl_induct3)
apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule BinOpRed2)
done
lemma BinOpRedsVal:
"⟦ P ⊢ ⟨e⇩1,s⇩0,b⇩0⟩ →* ⟨Val v⇩1,s⇩1,b⇩1⟩; P ⊢ ⟨e⇩2,s⇩1,b⇩1⟩ →* ⟨Val v⇩2,s⇩2,b⇩2⟩; binop(bop,v⇩1,v⇩2) = Some v ⟧
⟹ P ⊢ ⟨e⇩1 «bop» e⇩2, s⇩0,b⇩0⟩ →* ⟨Val v,s⇩2,b⇩2⟩"
apply(rule rtrancl_trans)
apply(erule BinOp1Reds)
apply(rule rtrancl_into_rtrancl)
apply(erule BinOp2Reds)
apply(rule RedBinOp)
apply simp
done
lemma BinOpRedsThrow1:
"P ⊢ ⟨e,s,b⟩ →* ⟨throw e',s',b'⟩ ⟹ P ⊢ ⟨e «bop» e⇩2, s,b⟩ →* ⟨throw e', s',b'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule BinOp1Reds)
apply(rule red_reds.BinOpThrow1)
done
lemma BinOpRedsThrow2:
"⟦ P ⊢ ⟨e⇩1,s⇩0,b⇩0⟩ →* ⟨Val v⇩1,s⇩1,b⇩1⟩; P ⊢ ⟨e⇩2,s⇩1,b⇩1⟩ →* ⟨throw e,s⇩2,b⇩2⟩⟧
⟹ P ⊢ ⟨e⇩1 «bop» e⇩2, s⇩0, b⇩0⟩ →* ⟨throw e,s⇩2,b⇩2⟩"
apply(rule rtrancl_trans)
apply(erule BinOp1Reds)
apply(rule rtrancl_into_rtrancl)
apply(erule BinOp2Reds)
apply(rule red_reds.BinOpThrow2)
done
subsubsection "FAcc"
lemma FAccReds:
"P ⊢ ⟨e,s,b⟩ →* ⟨e',s',b'⟩ ⟹ P ⊢ ⟨e∙F{D}, s,b⟩ →* ⟨e'∙F{D}, s',b'⟩"
apply(erule rtrancl_induct3)
apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule FAccRed)
done
lemma FAccRedsVal:
"⟦ P ⊢ ⟨e,s,b⟩ →* ⟨addr a,s',b'⟩; hp s' a = Some(C,fs); fs(F,D) = Some v;
P ⊢ C has F,NonStatic:t in D ⟧
⟹ P ⊢ ⟨e∙F{D},s,b⟩ →* ⟨Val v,s',b'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule FAccReds)
apply(cases s',simp)
apply(erule (2) RedFAcc)
done
lemma FAccRedsNull:
"P ⊢ ⟨e,s,b⟩ →* ⟨null,s',b'⟩ ⟹ P ⊢ ⟨e∙F{D},s,b⟩ →* ⟨THROW NullPointer,s',b'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule FAccReds)
apply(rule RedFAccNull)
done
lemma FAccRedsNone:
"⟦ P ⊢ ⟨e,s,b⟩ →* ⟨addr a,s',b'⟩;
hp s' a = Some(C,fs);
¬(∃b t. P ⊢ C has F,b:t in D) ⟧
⟹ P ⊢ ⟨e∙F{D},s,b⟩ →* ⟨THROW NoSuchFieldError,s',b'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule FAccReds)
apply(cases s',simp)
apply(erule RedFAccNone, simp)
done
lemma FAccRedsStatic:
"⟦ P ⊢ ⟨e,s,b⟩ →* ⟨addr a,s',b'⟩;
hp s' a = Some(C,fs);
P ⊢ C has F,Static:t in D ⟧
⟹ P ⊢ ⟨e∙F{D},s,b⟩ →* ⟨THROW IncompatibleClassChangeError,s',b'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule FAccReds)
apply(cases s',simp)
apply(erule (1) RedFAccStatic)
done
lemma FAccRedsThrow:
"P ⊢ ⟨e,s,b⟩ →* ⟨throw a,s',b'⟩ ⟹ P ⊢ ⟨e∙F{D},s,b⟩ →* ⟨throw a,s',b'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule FAccReds)
apply(rule red_reds.FAccThrow)
done
subsubsection "SFAcc"
lemma SFAccReds:
"⟦ P ⊢ C has F,Static:t in D;
shp s D = Some(sfs,Done); sfs F = Some v ⟧
⟹ P ⊢ ⟨C∙⇩sF{D},s,True⟩ →* ⟨Val v,s,False⟩"
apply(rule r_into_rtrancl)
apply(cases s,simp)
apply(erule (2) RedSFAcc)
done
lemma SFAccRedsNone:
"¬(∃b t. P ⊢ C has F,b:t in D)
⟹ P ⊢ ⟨C∙⇩sF{D},s,b⟩ →* ⟨THROW NoSuchFieldError,s,False⟩"
apply(rule r_into_rtrancl)
apply(cases s,simp)
apply(rule RedSFAccNone, simp)
done
lemma SFAccRedsNonStatic:
"P ⊢ C has F,NonStatic:t in D
⟹ P ⊢ ⟨C∙⇩sF{D},s,b⟩ →* ⟨THROW IncompatibleClassChangeError,s,False⟩"
apply(rule r_into_rtrancl)
apply(cases s,simp)
apply(erule RedSFAccNonStatic)
done
lemma SFAccInitDoneReds:
"⟦ P ⊢ C has F,Static:t in D;
shp s D = Some (sfs,Done);
sfs F = Some v ⟧
⟹ P ⊢ ⟨C∙⇩sF{D}, s,b⟩ →* ⟨Val v, s,False⟩"
apply(cases b)
apply(rule r_into_rtrancl)
apply(cases s, simp)
apply(erule (2) RedSFAcc)
apply(rule_tac b = "(C∙⇩sF{D},s,True)" in converse_rtrancl_into_rtrancl)
apply(cases s, simp)
apply(drule (2) SFAccInitDoneRed)
apply(erule SFAccReds, simp+)
done
lemma SFAccInitReds:
"⟦ P ⊢ C has F,Static:t in D;
∄sfs. shp s D = Some (sfs,Done);
P ⊢ ⟨INIT D ([D],False) ← unit,s,False⟩ →* ⟨Val v',s',b'⟩;
shp s' D = Some (sfs,i); sfs F = Some v ⟧
⟹ P ⊢ ⟨C∙⇩sF{D},s,False⟩ →* ⟨Val v,s',False⟩"
apply(rule_tac b = "(INIT D ([D],False) ← C∙⇩sF{D},s,False)" in converse_rtrancl_into_rtrancl)
apply(cases s, simp)
apply(simp add: SFAccInitRed)
apply(rule InitSeqReds, simp_all)
apply(subgoal_tac "∃T. P ⊢ C has F,Static:T in D")
prefer 2 apply fast
apply(rule r_into_rtrancl)
apply(cases s', simp)
apply(erule (2) RedSFAcc)
done
lemma SFAccInitThrowReds:
"⟦ P ⊢ C has F,Static:t in D;
∄sfs. shp s D = Some (sfs,Done);
P ⊢ ⟨INIT D ([D],False) ← unit,s,False⟩ →* ⟨throw a,s',b'⟩ ⟧
⟹ P ⊢ ⟨C∙⇩sF{D},s,False⟩ →* ⟨throw a,s',b'⟩"
apply(rule_tac b = "(INIT D ([D],False) ← C∙⇩sF{D},s,False)" in converse_rtrancl_into_rtrancl)
apply(cases s, simp)
apply (simp add: SFAccInitRed)
apply(erule InitSeqThrowReds)
done
subsubsection "FAss"
lemma FAssReds1:
"P ⊢ ⟨e,s,b⟩ →* ⟨e',s',b'⟩ ⟹ P ⊢ ⟨e∙F{D}:=e⇩2, s,b⟩ →* ⟨e'∙F{D}:=e⇩2, s',b'⟩"
apply(erule rtrancl_induct3)
apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule FAssRed1)
done
lemma FAssReds2:
"P ⊢ ⟨e,s,b⟩ →* ⟨e',s',b'⟩ ⟹ P ⊢ ⟨Val v∙F{D}:=e, s,b⟩ →* ⟨Val v∙F{D}:=e', s',b'⟩"
apply(erule rtrancl_induct3)
apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule FAssRed2)
done
lemma FAssRedsVal:
"⟦ P ⊢ ⟨e⇩1,s⇩0,b⇩0⟩ →* ⟨addr a,s⇩1,b⇩1⟩; P ⊢ ⟨e⇩2,s⇩1,b⇩1⟩ →* ⟨Val v,(h⇩2,l⇩2,sh⇩2),b⇩2⟩;
P ⊢ C has F,NonStatic:t in D; Some(C,fs) = h⇩2 a ⟧ ⟹
P ⊢ ⟨e⇩1∙F{D}:=e⇩2, s⇩0,b⇩0⟩ →* ⟨unit, (h⇩2(a↦(C,fs((F,D)↦v))),l⇩2,sh⇩2),b⇩2⟩"
apply(rule rtrancl_trans)
apply(erule FAssReds1)
apply(rule rtrancl_into_rtrancl)
apply(erule FAssReds2)
apply(rule RedFAss)
apply simp+
done
lemma FAssRedsNull:
"⟦ P ⊢ ⟨e⇩1,s⇩0,b⇩0⟩ →* ⟨null,s⇩1,b⇩1⟩; P ⊢ ⟨e⇩2,s⇩1,b⇩1⟩ →* ⟨Val v,s⇩2,b⇩2⟩ ⟧ ⟹
P ⊢ ⟨e⇩1∙F{D}:=e⇩2, s⇩0,b⇩0⟩ →* ⟨THROW NullPointer, s⇩2,b⇩2⟩"
apply(rule rtrancl_trans)
apply(erule FAssReds1)
apply(rule rtrancl_into_rtrancl)
apply(erule FAssReds2)
apply(rule RedFAssNull)
done
lemma FAssRedsThrow1:
"P ⊢ ⟨e,s,b⟩ →* ⟨throw e',s',b'⟩ ⟹ P ⊢ ⟨e∙F{D}:=e⇩2, s,b⟩ →* ⟨throw e', s',b'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule FAssReds1)
apply(rule red_reds.FAssThrow1)
done
lemma FAssRedsThrow2:
"⟦ P ⊢ ⟨e⇩1,s⇩0,b⇩0⟩ →* ⟨Val v,s⇩1,b⇩1⟩; P ⊢ ⟨e⇩2,s⇩1,b⇩1⟩ →* ⟨throw e,s⇩2,b⇩2⟩ ⟧
⟹ P ⊢ ⟨e⇩1∙F{D}:=e⇩2,s⇩0,b⇩0⟩ →* ⟨throw e,s⇩2,b⇩2⟩"
apply(rule rtrancl_trans)
apply(erule FAssReds1)
apply(rule rtrancl_into_rtrancl)
apply(erule FAssReds2)
apply(rule red_reds.FAssThrow2)
done
lemma FAssRedsNone:
"⟦ P ⊢ ⟨e⇩1,s⇩0,b⇩0⟩ →* ⟨addr a,s⇩1,b⇩1⟩; P ⊢ ⟨e⇩2,s⇩1,b⇩1⟩ →* ⟨Val v,(h⇩2,l⇩2,sh⇩2),b⇩2⟩;
h⇩2 a = Some(C,fs); ¬(∃b t. P ⊢ C has F,b:t in D) ⟧ ⟹
P ⊢ ⟨e⇩1∙F{D}:=e⇩2, s⇩0,b⇩0⟩ →* ⟨THROW NoSuchFieldError, (h⇩2,l⇩2,sh⇩2),b⇩2⟩"
apply(rule rtrancl_trans)
apply(erule FAssReds1)
apply(rule rtrancl_into_rtrancl)
apply(erule FAssReds2)
apply(rule RedFAssNone)
apply simp+
done
lemma FAssRedsStatic:
"⟦ P ⊢ ⟨e⇩1,s⇩0,b⇩0⟩ →* ⟨addr a,s⇩1,b⇩1⟩; P ⊢ ⟨e⇩2,s⇩1,b⇩1⟩ →* ⟨Val v,(h⇩2,l⇩2,sh⇩2),b⇩2⟩;
h⇩2 a = Some(C,fs); P ⊢ C has F,Static:t in D ⟧ ⟹
P ⊢ ⟨e⇩1∙F{D}:=e⇩2, s⇩0,b⇩0⟩ →* ⟨THROW IncompatibleClassChangeError, (h⇩2,l⇩2,sh⇩2),b⇩2⟩"
apply(rule rtrancl_trans)
apply(erule FAssReds1)
apply(rule rtrancl_into_rtrancl)
apply(erule FAssReds2)
apply(rule RedFAssStatic)
apply simp+
done
subsubsection "SFAss"
lemma SFAssReds:
"P ⊢ ⟨e,s,b⟩ →* ⟨e',s',b'⟩ ⟹ P ⊢ ⟨C∙⇩sF{D}:=e,s,b⟩ →* ⟨C∙⇩sF{D}:=e',s',b'⟩"
apply(erule rtrancl_induct3)
apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule SFAssRed)
done
lemma SFAssRedsVal:
"⟦ P ⊢ ⟨e⇩2,s⇩0,b⇩0⟩ →* ⟨Val v,(h⇩2,l⇩2,sh⇩2),b⇩2⟩;
P ⊢ C has F,Static:t in D; sh⇩2 D = ⌊(sfs,Done)⌋ ⟧ ⟹
P ⊢ ⟨C∙⇩sF{D}:=e⇩2, s⇩0,b⇩0⟩ →* ⟨unit, (h⇩2,l⇩2,sh⇩2(D↦(sfs(F↦v), Done))),False⟩"
apply(rule rtrancl_trans)
apply(erule SFAssReds)
apply(cases b⇩2)
apply(rule r_into_rtrancl)
apply(drule_tac l = l⇩2 in RedSFAss, simp_all)
apply(rule converse_rtrancl_into_rtrancl)
apply(drule_tac sh = sh⇩2 in SFAssInitDoneRed, simp_all)
apply(rule r_into_rtrancl)
apply(drule_tac l = l⇩2 in RedSFAss, simp_all)
done
lemma SFAssRedsThrow:
"⟦ P ⊢ ⟨e⇩2,s⇩0,b⇩0⟩ →* ⟨throw e,s⇩2,b⇩2⟩ ⟧
⟹ P ⊢ ⟨C∙⇩sF{D}:=e⇩2,s⇩0,b⇩0⟩ →* ⟨throw e,s⇩2,b⇩2⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule SFAssReds)
apply(rule red_reds.SFAssThrow)
done
lemma SFAssRedsNone:
"⟦ P ⊢ ⟨e⇩2,s⇩0,b⇩0⟩ →* ⟨Val v,(h⇩2,l⇩2,sh⇩2),b⇩2⟩;
¬(∃b t. P ⊢ C has F,b:t in D) ⟧ ⟹
P ⊢ ⟨C∙⇩sF{D}:=e⇩2,s⇩0,b⇩0⟩ →* ⟨THROW NoSuchFieldError, (h⇩2,l⇩2,sh⇩2),False⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule SFAssReds)
apply(rule RedSFAssNone)
apply simp
done
lemma SFAssRedsNonStatic:
"⟦ P ⊢ ⟨e⇩2,s⇩0,b⇩0⟩ →* ⟨Val v,(h⇩2,l⇩2,sh⇩2),b⇩2⟩;
P ⊢ C has F,NonStatic:t in D ⟧ ⟹
P ⊢ ⟨C∙⇩sF{D}:=e⇩2,s⇩0,b⇩0⟩ →* ⟨THROW IncompatibleClassChangeError,(h⇩2,l⇩2,sh⇩2),False⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule SFAssReds)
apply(rule RedSFAssNonStatic)
apply simp
done
lemma SFAssInitReds:
"⟦ P ⊢ ⟨e⇩2,s⇩0,b⇩0⟩ →* ⟨Val v,(h⇩2,l⇩2,sh⇩2),False⟩;
P ⊢ C has F,Static:t in D;
∄sfs. sh⇩2 D = Some (sfs, Done);
P ⊢ ⟨INIT D ([D],False) ← unit,(h⇩2,l⇩2,sh⇩2),False⟩ →* ⟨Val v',(h',l',sh'),b'⟩;
sh' D = Some(sfs,i);
sfs' = sfs(F↦v); sh'' = sh'(D↦(sfs',i)) ⟧
⟹ P ⊢ ⟨C∙⇩sF{D}:=e⇩2,s⇩0,b⇩0⟩ →* ⟨unit,(h',l',sh''),False⟩"
apply(rule rtrancl_trans)
apply(erule SFAssReds)
apply(rule_tac converse_rtrancl_into_rtrancl)
apply(erule (1) SFAssInitRed)
apply(erule InitSeqReds, simp_all)
apply(subgoal_tac "∃T. P ⊢ C has F,Static:T in D")
prefer 2 apply fast
apply(simp,rule r_into_rtrancl)
apply(erule (2) RedSFAss)
apply simp
done
lemma SFAssInitThrowReds:
"⟦ P ⊢ ⟨e⇩2,s⇩0,b⇩0⟩ →* ⟨Val v,(h⇩2,l⇩2,sh⇩2),False⟩;
P ⊢ C has F,Static:t in D;
∄sfs. sh⇩2 D = Some (sfs, Done);
P ⊢ ⟨INIT D ([D],False) ← unit,(h⇩2,l⇩2,sh⇩2),False⟩ →* ⟨throw a,s',b'⟩ ⟧
⟹ P ⊢ ⟨C∙⇩sF{D}:=e⇩2,s⇩0,b⇩0⟩ →* ⟨throw a,s',b'⟩"
apply(rule rtrancl_trans)
apply(erule SFAssReds)
apply(rule converse_rtrancl_into_rtrancl)
apply(erule (1) SFAssInitRed)
apply(erule InitSeqThrowReds)
done
subsubsection";;"
lemma SeqReds:
"P ⊢ ⟨e,s,b⟩ →* ⟨e',s',b'⟩ ⟹ P ⊢ ⟨e;;e⇩2, s,b⟩ →* ⟨e';;e⇩2, s',b'⟩"
apply(erule rtrancl_induct3)
apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule SeqRed)
done
lemma SeqRedsThrow:
"P ⊢ ⟨e,s,b⟩ →* ⟨throw e',s',b'⟩ ⟹ P ⊢ ⟨e;;e⇩2, s,b⟩ →* ⟨throw e', s',b'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule SeqReds)
apply(rule red_reds.SeqThrow)
done
lemma SeqReds2:
"⟦ P ⊢ ⟨e⇩1,s⇩0,b⇩0⟩ →* ⟨Val v⇩1,s⇩1,b⇩1⟩; P ⊢ ⟨e⇩2,s⇩1,b⇩1⟩ →* ⟨e⇩2',s⇩2,b⇩2⟩ ⟧ ⟹ P ⊢ ⟨e⇩1;;e⇩2, s⇩0,b⇩0⟩ →* ⟨e⇩2',s⇩2,b⇩2⟩"
apply(rule rtrancl_trans)
apply(erule SeqReds)
apply(rule converse_rtrancl_into_rtrancl)
apply(rule RedSeq)
apply assumption
done
subsubsection"If"
lemma CondReds:
"P ⊢ ⟨e,s,b⟩ →* ⟨e',s',b'⟩ ⟹ P ⊢ ⟨if (e) e⇩1 else e⇩2,s,b⟩ →* ⟨if (e') e⇩1 else e⇩2,s',b'⟩"
apply(erule rtrancl_induct3)
apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule CondRed)
done
lemma CondRedsThrow:
"P ⊢ ⟨e,s,b⟩ →* ⟨throw a,s',b'⟩ ⟹ P ⊢ ⟨if (e) e⇩1 else e⇩2, s,b⟩ →* ⟨throw a,s',b'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule CondReds)
apply(rule red_reds.CondThrow)
done
lemma CondReds2T:
"⟦P ⊢ ⟨e,s⇩0,b⇩0⟩ →* ⟨true,s⇩1,b⇩1⟩; P ⊢ ⟨e⇩1, s⇩1,b⇩1⟩ →* ⟨e',s⇩2,b⇩2⟩ ⟧ ⟹ P ⊢ ⟨if (e) e⇩1 else e⇩2, s⇩0,b⇩0⟩ →* ⟨e',s⇩2,b⇩2⟩"
apply(rule rtrancl_trans)
apply(erule CondReds)
apply(rule converse_rtrancl_into_rtrancl)
apply(rule RedCondT)
apply assumption
done
lemma CondReds2F:
"⟦P ⊢ ⟨e,s⇩0,b⇩0⟩ →* ⟨false,s⇩1,b⇩1⟩; P ⊢ ⟨e⇩2, s⇩1,b⇩1⟩ →* ⟨e',s⇩2,b⇩2⟩ ⟧ ⟹ P ⊢ ⟨if (e) e⇩1 else e⇩2, s⇩0,b⇩0⟩ →* ⟨e',s⇩2,b⇩2⟩"
apply(rule rtrancl_trans)
apply(erule CondReds)
apply(rule converse_rtrancl_into_rtrancl)
apply(rule RedCondF)
apply assumption
done
subsubsection "While"
lemma WhileFReds:
"P ⊢ ⟨b,s,b⇩0⟩ →* ⟨false,s',b'⟩ ⟹ P ⊢ ⟨while (b) c,s,b⇩0⟩ →* ⟨unit,s',b'⟩"
apply(rule converse_rtrancl_into_rtrancl)
apply(rule RedWhile)
apply(rule rtrancl_into_rtrancl)
apply(erule CondReds)
apply(rule RedCondF)
done
lemma WhileRedsThrow:
"P ⊢ ⟨b,s,b⇩0⟩ →* ⟨throw e,s',b'⟩ ⟹ P ⊢ ⟨while (b) c,s,b⇩0⟩ →* ⟨throw e,s',b'⟩"
apply(rule converse_rtrancl_into_rtrancl)
apply(rule RedWhile)
apply(rule rtrancl_into_rtrancl)
apply(erule CondReds)
apply(rule red_reds.CondThrow)
done
lemma WhileTReds:
"⟦ P ⊢ ⟨b,s⇩0,b⇩0⟩ →* ⟨true,s⇩1,b⇩1⟩; P ⊢ ⟨c,s⇩1,b⇩1⟩ →* ⟨Val v⇩1,s⇩2,b⇩2⟩; P ⊢ ⟨while (b) c,s⇩2,b⇩2⟩ →* ⟨e,s⇩3,b⇩3⟩ ⟧
⟹ P ⊢ ⟨while (b) c,s⇩0,b⇩0⟩ →* ⟨e,s⇩3,b⇩3⟩"
apply(rule converse_rtrancl_into_rtrancl)
apply(rule RedWhile)
apply(rule rtrancl_trans)
apply(erule CondReds)
apply(rule converse_rtrancl_into_rtrancl)
apply(rule RedCondT)
apply(rule rtrancl_trans)
apply(erule SeqReds)
apply(rule converse_rtrancl_into_rtrancl)
apply(rule RedSeq)
apply assumption
done
lemma WhileTRedsThrow:
"⟦ P ⊢ ⟨b,s⇩0,b⇩0⟩ →* ⟨true,s⇩1,b⇩1⟩; P ⊢ ⟨c,s⇩1,b⇩1⟩ →* ⟨throw e,s⇩2,b⇩2⟩ ⟧
⟹ P ⊢ ⟨while (b) c,s⇩0,b⇩0⟩ →* ⟨throw e,s⇩2,b⇩2⟩"
apply(rule converse_rtrancl_into_rtrancl)
apply(rule RedWhile)
apply(rule rtrancl_trans)
apply(erule CondReds)
apply(rule converse_rtrancl_into_rtrancl)
apply(rule RedCondT)
apply(rule rtrancl_into_rtrancl)
apply(erule SeqReds)
apply(rule red_reds.SeqThrow)
done
subsubsection"Throw"
lemma ThrowReds:
"P ⊢ ⟨e,s,b⟩ →* ⟨e',s',b'⟩ ⟹ P ⊢ ⟨throw e,s,b⟩ →* ⟨throw e',s',b'⟩"
apply(erule rtrancl_induct3)
apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule ThrowRed)
done
lemma ThrowRedsNull:
"P ⊢ ⟨e,s,b⟩ →* ⟨null,s',b'⟩ ⟹ P ⊢ ⟨throw e,s,b⟩ →* ⟨THROW NullPointer,s',b'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule ThrowReds)
apply(rule RedThrowNull)
done
lemma ThrowRedsThrow:
"P ⊢ ⟨e,s,b⟩ →* ⟨throw a,s',b'⟩ ⟹ P ⊢ ⟨throw e,s,b⟩ →* ⟨throw a,s',b'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule ThrowReds)
apply(rule red_reds.ThrowThrow)
done
subsubsection "InitBlock"
lemma InitBlockReds_aux:
"P ⊢ ⟨e,s,b⟩ →* ⟨e',s',b'⟩ ⟹
∀h l sh h' l' sh' v. s = (h,l(V↦v),sh) ⟶ s' = (h',l',sh') ⟶
P ⊢ ⟨{V:T := Val v; e},(h,l,sh),b⟩ →* ⟨{V:T := Val(the(l' V)); e'},(h',l'(V:=(l V)),sh'),b'⟩"
apply(erule converse_rtrancl_induct3)
apply(fastforce simp: fun_upd_same simp del:fun_upd_apply)
apply clarify
apply(rename_tac e0 X Y x3 b0 e1 h1 l1 sh1 b1 h0 l0 sh0 h2 l2 sh2 v0)
apply(subgoal_tac "V ∈ dom l1")
prefer 2
apply(drule red_lcl_incr)
apply simp
apply clarsimp
apply(rename_tac v1)
apply(rule converse_rtrancl_into_rtrancl)
apply(rule InitBlockRed)
apply assumption
apply simp
apply(erule_tac x = "l1(V := l0 V)" in allE)
apply(erule_tac x = v1 in allE)
apply(erule impE)
apply(rule ext)
apply(simp add:fun_upd_def)
apply(simp add:fun_upd_def)
done
lemma InitBlockReds:
"P ⊢ ⟨e, (h,l(V↦v),sh),b⟩ →* ⟨e', (h',l',sh'),b'⟩ ⟹
P ⊢ ⟨{V:T := Val v; e}, (h,l,sh),b⟩ →* ⟨{V:T := Val(the(l' V)); e'}, (h',l'(V:=(l V)),sh'),b'⟩"
by(blast dest:InitBlockReds_aux)
lemma InitBlockRedsFinal:
"⟦ P ⊢ ⟨e,(h,l(V↦v),sh),b⟩ →* ⟨e',(h',l',sh'),b'⟩; final e' ⟧ ⟹
P ⊢ ⟨{V:T := Val v; e},(h,l,sh),b⟩ →* ⟨e',(h', l'(V := l V),sh'),b'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule InitBlockReds)
apply(fast elim!:finalE intro:RedInitBlock InitBlockThrow)
done
subsubsection "Block"
lemmas converse_rtranclE3 = converse_rtranclE [of "(xa,xb,xc)" "(za,zb,zc)", split_rule]
lemma BlockRedsFinal:
assumes reds: "P ⊢ ⟨e⇩0,s⇩0,b⇩0⟩ →* ⟨e⇩2,(h⇩2,l⇩2,sh⇩2),b⇩2⟩" and fin: "final e⇩2"
shows "⋀h⇩0 l⇩0 sh⇩0. s⇩0 = (h⇩0,l⇩0(V:=None),sh⇩0) ⟹ P ⊢ ⟨{V:T; e⇩0},(h⇩0,l⇩0,sh⇩0),b⇩0⟩ →* ⟨e⇩2,(h⇩2,l⇩2(V:=l⇩0 V),sh⇩2),b⇩2⟩"
using reds
proof (induct rule:converse_rtrancl_induct3)
case refl thus ?case
by(fastforce intro:finalE[OF fin] RedBlock BlockThrow
simp del:fun_upd_apply)
next
case (step e⇩0 s⇩0 b⇩0 e⇩1 s⇩1 b⇩1)
have red: "P ⊢ ⟨e⇩0,s⇩0,b⇩0⟩ → ⟨e⇩1,s⇩1,b⇩1⟩"
and reds: "P ⊢ ⟨e⇩1,s⇩1,b⇩1⟩ →* ⟨e⇩2,(h⇩2,l⇩2,sh⇩2),b⇩2⟩"
and IH: "⋀h l sh. s⇩1 = (h,l(V := None),sh)
⟹ P ⊢ ⟨{V:T; e⇩1},(h,l,sh),b⇩1⟩ →* ⟨e⇩2,(h⇩2, l⇩2(V := l V),sh⇩2),b⇩2⟩"
and s⇩0: "s⇩0 = (h⇩0, l⇩0(V := None),sh⇩0)" by fact+
obtain h⇩1 l⇩1 sh⇩1 where s⇩1: "s⇩1 = (h⇩1,l⇩1,sh⇩1)"
using prod_cases3 by blast
show ?case
proof cases
assume "assigned V e⇩0"
then obtain v e where e⇩0: "e⇩0 = V := Val v;; e"
by (unfold assigned_def)blast
from red e⇩0 s⇩0 have e⇩1: "e⇩1 = unit;;e" and s⇩1: "s⇩1 = (h⇩0, l⇩0(V ↦ v),sh⇩0)" and b⇩1: "b⇩1 = b⇩0"
by auto
from e⇩1 fin have "e⇩1 ≠ e⇩2" by (auto simp:final_def)
then obtain e' s' b' where red1: "P ⊢ ⟨e⇩1,s⇩1,b⇩1⟩ → ⟨e',s',b'⟩"
and reds': "P ⊢ ⟨e',s',b'⟩ →* ⟨e⇩2,(h⇩2,l⇩2,sh⇩2),b⇩2⟩"
using converse_rtranclE3[OF reds] by blast
from red1 e⇩1 b⇩1 have es': "e' = e" "s' = s⇩1" "b' = b⇩0" by auto
show ?case using e⇩0 s⇩1 es' reds'
by(auto intro!: InitBlockRedsFinal[OF _ fin] simp del:fun_upd_apply)
next
assume unass: "¬ assigned V e⇩0"
show ?thesis
proof (cases "l⇩1 V")
assume None: "l⇩1 V = None"
hence "P ⊢ ⟨{V:T; e⇩0},(h⇩0,l⇩0,sh⇩0),b⇩0⟩ → ⟨{V:T; e⇩1},(h⇩1, l⇩1(V := l⇩0 V),sh⇩1),b⇩1⟩"
using s⇩0 s⇩1 red by(simp add: BlockRedNone[OF _ _ unass])
moreover
have "P ⊢ ⟨{V:T; e⇩1},(h⇩1, l⇩1(V := l⇩0 V),sh⇩1),b⇩1⟩ →* ⟨e⇩2,(h⇩2, l⇩2(V := l⇩0 V),sh⇩2),b⇩2⟩"
using IH[of _ "l⇩1(V := l⇩0 V)"] s⇩1 None by(simp add:fun_upd_idem)
ultimately show ?case by(rule converse_rtrancl_into_rtrancl)
next
fix v assume Some: "l⇩1 V = Some v"
hence "P ⊢ ⟨{V:T;e⇩0},(h⇩0,l⇩0,sh⇩0),b⇩0⟩ → ⟨{V:T := Val v; e⇩1},(h⇩1,l⇩1(V := l⇩0 V),sh⇩1),b⇩1⟩"
using s⇩0 s⇩1 red by(simp add: BlockRedSome[OF _ _ unass])
moreover
have "P ⊢ ⟨{V:T := Val v; e⇩1},(h⇩1,l⇩1(V:= l⇩0 V),sh⇩1),b⇩1⟩ →*
⟨e⇩2,(h⇩2,l⇩2(V:=l⇩0 V),sh⇩2),b⇩2⟩"
using InitBlockRedsFinal[OF _ fin,of _ _ "l⇩1(V:=l⇩0 V)" V]
Some reds s⇩1 by(simp add:fun_upd_idem)
ultimately show ?case by(rule converse_rtrancl_into_rtrancl)
qed
qed
qed
subsubsection "try-catch"
lemma TryReds:
"P ⊢ ⟨e,s,b⟩ →* ⟨e',s',b'⟩ ⟹ P ⊢ ⟨try e catch(C V) e⇩2,s,b⟩ →* ⟨try e' catch(C V) e⇩2,s',b'⟩"
apply(erule rtrancl_induct3)
apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule TryRed)
done
lemma TryRedsVal:
"P ⊢ ⟨e,s,b⟩ →* ⟨Val v,s',b'⟩ ⟹ P ⊢ ⟨try e catch(C V) e⇩2,s,b⟩ →* ⟨Val v,s',b'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule TryReds)
apply(rule RedTry)
done
lemma TryCatchRedsFinal:
"⟦ P ⊢ ⟨e⇩1,s⇩0,b⇩0⟩ →* ⟨Throw a,(h⇩1,l⇩1,sh⇩1),b⇩1⟩; h⇩1 a = Some(D,fs); P ⊢ D ≼⇧* C;
P ⊢ ⟨e⇩2, (h⇩1, l⇩1(V ↦ Addr a),sh⇩1),b⇩1⟩ →* ⟨e⇩2', (h⇩2,l⇩2,sh⇩2), b⇩2⟩; final e⇩2' ⟧
⟹ P ⊢ ⟨try e⇩1 catch(C V) e⇩2, s⇩0, b⇩0⟩ →* ⟨e⇩2', (h⇩2, l⇩2(V := l⇩1 V),sh⇩2),b⇩2⟩"
apply(rule rtrancl_trans)
apply(erule TryReds)
apply(rule converse_rtrancl_into_rtrancl)
apply(rule RedTryCatch)
apply fastforce
apply assumption
apply(rule InitBlockRedsFinal)
apply assumption
apply(simp)
done
lemma TryRedsFail:
"⟦ P ⊢ ⟨e⇩1,s,b⟩ →* ⟨Throw a,(h,l,sh),b'⟩; h a = Some(D,fs); ¬ P ⊢ D ≼⇧* C ⟧
⟹ P ⊢ ⟨try e⇩1 catch(C V) e⇩2,s,b⟩ →* ⟨Throw a,(h,l,sh),b'⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule TryReds)
apply(fastforce intro!: RedTryFail)
done
subsubsection "List"
lemma ListReds1:
"P ⊢ ⟨e,s,b⟩ →* ⟨e',s',b'⟩ ⟹ P ⊢ ⟨e#es,s,b⟩ [→]* ⟨e' # es,s',b'⟩"
apply(erule rtrancl_induct3)
apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule ListRed1)
done
lemma ListReds2:
"P ⊢ ⟨es,s,b⟩ [→]* ⟨es',s',b'⟩ ⟹ P ⊢ ⟨Val v # es,s,b⟩ [→]* ⟨Val v # es',s',b'⟩"
apply(erule rtrancl_induct3)
apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule ListRed2)
done
lemma ListRedsVal:
"⟦ P ⊢ ⟨e,s⇩0,b⇩0⟩ →* ⟨Val v,s⇩1,b⇩1⟩; P ⊢ ⟨es,s⇩1,b⇩1⟩ [→]* ⟨es',s⇩2,b⇩2⟩ ⟧
⟹ P ⊢ ⟨e#es,s⇩0,b⇩0⟩ [→]* ⟨Val v # es',s⇩2,b⇩2⟩"
apply(rule rtrancl_trans)
apply(erule ListReds1)
apply(erule ListReds2)
done
subsubsection"Call"
text‹ First a few lemmas on what happens to free variables during redction. ›
lemma assumes wf: "wwf_J_prog P"
shows Red_fv: "P ⊢ ⟨e,(h,l,sh),b⟩ → ⟨e',(h',l',sh'),b'⟩ ⟹ fv e' ⊆ fv e"
and "P ⊢ ⟨es,(h,l,sh),b⟩ [→] ⟨es',(h',l',sh'),b'⟩ ⟹ fvs es' ⊆ fvs es"
proof (induct rule:red_reds_inducts)
case (RedCall h a C fs M Ts T pns body D vs l sh b)
hence "fv body ⊆ {this} ∪ set pns"
using assms by(fastforce dest!:sees_wf_mdecl simp:wf_mdecl_def)
with RedCall.hyps show ?case by fastforce
next
case (RedSCall C M Ts T pns body D vs)
hence "fv body ⊆ set pns"
using assms by(fastforce dest!:sees_wf_mdecl simp:wf_mdecl_def)
with RedSCall.hyps show ?case by fastforce
qed auto
lemma Red_dom_lcl:
"P ⊢ ⟨e,(h,l,sh),b⟩ → ⟨e',(h',l',sh'),b'⟩ ⟹ dom l' ⊆ dom l ∪ fv e" and
"P ⊢ ⟨es,(h,l,sh),b⟩ [→] ⟨es',(h',l',sh'),b'⟩ ⟹ dom l' ⊆ dom l ∪ fvs es"
proof (induct rule:red_reds_inducts)
case RedLAss thus ?case by(force split:if_splits)
next
case CallParams thus ?case by(force split:if_splits)
next
case BlockRedNone thus ?case by clarsimp (fastforce split:if_splits)
next
case BlockRedSome thus ?case by clarsimp (fastforce split:if_splits)
next
case InitBlockRed thus ?case by clarsimp (fastforce split:if_splits)
qed auto
lemma Reds_dom_lcl:
"⟦ wwf_J_prog P; P ⊢ ⟨e,(h,l,sh),b⟩ →* ⟨e',(h',l',sh'),b'⟩ ⟧ ⟹ dom l' ⊆ dom l ∪ fv e"
apply(erule converse_rtrancl_induct_red)
apply blast
apply(blast dest: Red_fv Red_dom_lcl)
done
text‹ Now a few lemmas on the behaviour of blocks during reduction. ›
lemma override_on_upd_lemma:
"(override_on f (g(a↦b)) A)(a := g a) = override_on f g (insert a A)"
apply(rule ext)
apply(simp add:override_on_def)
done
declare fun_upd_apply[simp del] map_upds_twist[simp del]
lemma blocksReds:
"⋀l. ⟦ length Vs = length Ts; length vs = length Ts; distinct Vs;
P ⊢ ⟨e, (h,l(Vs [↦] vs),sh),b⟩ →* ⟨e', (h',l',sh'),b'⟩ ⟧
⟹ P ⊢ ⟨blocks(Vs,Ts,vs,e), (h,l,sh),b⟩ →* ⟨blocks(Vs,Ts,map (the ∘ l') Vs,e'), (h',override_on l' l (set Vs),sh'),b'⟩"
proof(induct Vs Ts vs e rule:blocks_induct)
case (1 V Vs T Ts v vs e) show ?case
using InitBlockReds[OF "1.hyps"[of "l(V↦v)"]] "1.prems"
by(auto simp:override_on_upd_lemma)
qed auto
lemma blocksFinal:
"⋀l. ⟦ length Vs = length Ts; length vs = length Ts; final e ⟧ ⟹
P ⊢ ⟨blocks(Vs,Ts,vs,e), (h,l,sh),b⟩ →* ⟨e, (h,l,sh),b⟩"
proof(induct Vs Ts vs e rule:blocks_induct)
case 1
show ?case using "1.prems" InitBlockReds[OF "1.hyps"]
by(fastforce elim!:finalE elim: rtrancl_into_rtrancl[OF _ RedInitBlock]
rtrancl_into_rtrancl[OF _ InitBlockThrow])
qed auto
lemma blocksRedsFinal:
assumes wf: "length Vs = length Ts" "length vs = length Ts" "distinct Vs"
and reds: "P ⊢ ⟨e, (h,l(Vs [↦] vs),sh),b⟩ →* ⟨e', (h',l',sh'),b'⟩"
and fin: "final e'" and l'': "l'' = override_on l' l (set Vs)"
shows "P ⊢ ⟨blocks(Vs,Ts,vs,e), (h,l,sh),b⟩ →* ⟨e', (h',l'',sh'),b'⟩"
proof -
let ?bv = "blocks(Vs,Ts,map (the o l') Vs,e')"
have "P ⊢ ⟨blocks(Vs,Ts,vs,e), (h,l,sh),b⟩ →* ⟨?bv, (h',l'',sh'),b'⟩"
using l'' by simp (rule blocksReds[OF wf reds])
also have "P ⊢ ⟨?bv, (h',l'',sh'),b'⟩ →* ⟨e', (h',l'',sh'),b'⟩"
using wf by(fastforce intro:blocksFinal fin)
finally show ?thesis .
qed
text‹ An now the actual method call reduction lemmas. ›
lemma CallRedsObj:
"P ⊢ ⟨e,s,b⟩ →* ⟨e',s',b'⟩ ⟹ P ⊢ ⟨e∙M(es),s,b⟩ →* ⟨e'∙M(es),s',b'⟩"
apply(erule rtrancl_induct3)
apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule CallObj)
done
lemma CallRedsParams:
"P ⊢ ⟨es,s,b⟩ [→]* ⟨es',s',b'⟩ ⟹ P ⊢ ⟨(Val v)∙M(es),s,b⟩ →* ⟨(Val v)∙M(es'),s',b'⟩"
apply(erule rtrancl_induct3)
apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule CallParams)
done
lemma CallRedsFinal:
assumes wwf: "wwf_J_prog P"
and "P ⊢ ⟨e,s⇩0,b⇩0⟩ →* ⟨addr a,s⇩1,b⇩1⟩"
"P ⊢ ⟨es,s⇩1,b⇩1⟩ [→]* ⟨map Val vs,(h⇩2,l⇩2,sh⇩2),b⇩2⟩"
"h⇩2 a = Some(C,fs)" "P ⊢ C sees M,NonStatic:Ts→T = (pns,body) in D"
"size vs = size pns"
and l⇩2': "l⇩2' = [this ↦ Addr a, pns[↦]vs]"
and body: "P ⊢ ⟨body,(h⇩2,l⇩2',sh⇩2),b⇩2⟩ →* ⟨ef,(h⇩3,l⇩3,sh⇩3),b⇩3⟩"
and "final ef"
shows "P ⊢ ⟨e∙M(es), s⇩0,b⇩0⟩ →* ⟨ef,(h⇩3,l⇩2,sh⇩3),b⇩3⟩"
proof -
have wf: "size Ts = size pns ∧ distinct pns ∧ this ∉ set pns"
and wt: "fv body ⊆ {this} ∪ set pns"
using assms by(fastforce dest!:sees_wf_mdecl simp:wf_mdecl_def)+
from body[THEN Red_lcl_add, of l⇩2]
have body': "P ⊢ ⟨body,(h⇩2,l⇩2(this↦ Addr a, pns[↦]vs),sh⇩2),b⇩2⟩ →* ⟨ef,(h⇩3,l⇩2++l⇩3,sh⇩3),b⇩3⟩"
by (simp add:l⇩2')
have "dom l⇩3 ⊆ {this} ∪ set pns"
using Reds_dom_lcl[OF wwf body] wt l⇩2' set_take_subset by force
hence eql⇩2: "override_on (l⇩2++l⇩3) l⇩2 ({this} ∪ set pns) = l⇩2"
by(fastforce simp add:map_add_def override_on_def fun_eq_iff)
have "P ⊢ ⟨e∙M(es),s⇩0,b⇩0⟩ →* ⟨(addr a)∙M(es),s⇩1,b⇩1⟩" by(rule CallRedsObj)(rule assms(2))
also have "P ⊢ ⟨(addr a)∙M(es),s⇩1,b⇩1⟩ →*
⟨(addr a)∙M(map Val vs),(h⇩2,l⇩2,sh⇩2),b⇩2⟩"
by(rule CallRedsParams)(rule assms(3))
also have "P ⊢ ⟨(addr a)∙M(map Val vs), (h⇩2,l⇩2,sh⇩2),b⇩2⟩ →
⟨blocks(this#pns, Class D#Ts, Addr a#vs, body), (h⇩2,l⇩2,sh⇩2),b⇩2⟩"
by(rule RedCall)(auto simp: assms wf, rule assms(5))
also (rtrancl_into_rtrancl) have "P ⊢ ⟨blocks(this#pns, Class D#Ts, Addr a#vs, body), (h⇩2,l⇩2,sh⇩2),b⇩2⟩
→* ⟨ef,(h⇩3,override_on (l⇩2++l⇩3) l⇩2 ({this} ∪ set pns),sh⇩3),b⇩3⟩"
by(rule blocksRedsFinal, insert assms wf body', simp_all)
finally show ?thesis using eql⇩2 by simp
qed
lemma CallRedsThrowParams:
"⟦ P ⊢ ⟨e,s⇩0,b⇩0⟩ →* ⟨Val v,s⇩1,b⇩1⟩; P ⊢ ⟨es,s⇩1,b⇩1⟩ [→]* ⟨map Val vs⇩1 @ throw a # es⇩2,s⇩2,b⇩2⟩ ⟧
⟹ P ⊢ ⟨e∙M(es),s⇩0,b⇩0⟩ →* ⟨throw a,s⇩2,b⇩2⟩"
apply(rule rtrancl_trans)
apply(erule CallRedsObj)
apply(rule rtrancl_into_rtrancl)
apply(erule CallRedsParams)
apply(rule CallThrowParams)
apply simp
done
lemma CallRedsThrowObj:
"P ⊢ ⟨e,s⇩0,b⇩0⟩ →* ⟨throw a,s⇩1,b⇩1⟩ ⟹ P ⊢ ⟨e∙M(es),s⇩0,b⇩0⟩ →* ⟨throw a,s⇩1,b⇩1⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule CallRedsObj)
apply(rule CallThrowObj)
done
lemma CallRedsNull:
"⟦ P ⊢ ⟨e,s⇩0,b⇩0⟩ →* ⟨null,s⇩1,b⇩1⟩; P ⊢ ⟨es,s⇩1,b⇩1⟩ [→]* ⟨map Val vs,s⇩2,b⇩2⟩ ⟧
⟹ P ⊢ ⟨e∙M(es),s⇩0,b⇩0⟩ →* ⟨THROW NullPointer,s⇩2,b⇩2⟩"
apply(rule rtrancl_trans)
apply(erule CallRedsObj)
apply(rule rtrancl_into_rtrancl)
apply(erule CallRedsParams)
apply(rule RedCallNull)
done
lemma CallRedsNone:
"⟦ P ⊢ ⟨e,s,b⟩ →* ⟨addr a,s⇩1,b⇩1⟩; P ⊢ ⟨es,s⇩1,b⇩1⟩ [→]* ⟨map Val vs,s⇩2,b⇩2⟩;
hp s⇩2 a = Some(C,fs);
¬(∃b Ts T m D. P ⊢ C sees M,b:Ts→T = m in D) ⟧
⟹ P ⊢ ⟨e∙M(es),s,b⟩ →* ⟨THROW NoSuchMethodError,s⇩2,b⇩2⟩"
apply(rule rtrancl_trans)
apply(erule CallRedsObj)
apply(rule rtrancl_into_rtrancl)
apply(erule CallRedsParams)
apply(cases s⇩2,simp)
apply(erule RedCallNone, simp)
done
lemma CallRedsStatic:
"⟦ P ⊢ ⟨e,s,b⟩ →* ⟨addr a,s⇩1,b⇩1⟩; P ⊢ ⟨es,s⇩1,b⇩1⟩ [→]* ⟨map Val vs,s⇩2,b⇩2⟩;
hp s⇩2 a = Some(C,fs);
P ⊢ C sees M,Static:Ts→T = m in D ⟧
⟹ P ⊢ ⟨e∙M(es),s,b⟩ →* ⟨THROW IncompatibleClassChangeError,s⇩2,b⇩2⟩"
apply(rule rtrancl_trans)
apply(erule CallRedsObj)
apply(rule rtrancl_into_rtrancl)
apply(erule CallRedsParams)
apply(cases s⇩2,simp)
apply(erule RedCallStatic, simp)
done
subsection‹SCall›
lemma SCallRedsParams:
"P ⊢ ⟨es,s,b⟩ [→]* ⟨es',s',b'⟩ ⟹ P ⊢ ⟨C∙⇩sM(es),s,b⟩ →* ⟨C∙⇩sM(es'),s',b'⟩"
apply(erule rtrancl_induct3)
apply blast
apply(erule rtrancl_into_rtrancl)
apply(erule SCallParams)
done
lemma SCallRedsFinal:
assumes wwf: "wwf_J_prog P"
and "P ⊢ ⟨es,s⇩0,b⇩0⟩ [→]* ⟨map Val vs,(h⇩2,l⇩2,sh⇩2),b⇩2⟩"
"P ⊢ C sees M,Static:Ts→T = (pns,body) in D"
"sh⇩2 D = Some(sfs,Done) ∨ (M = clinit ∧ sh⇩2 D = ⌊(sfs, Processing)⌋)"
"size vs = size pns"
and l⇩2': "l⇩2' = [pns[↦]vs]"
and body: "P ⊢ ⟨body,(h⇩2,l⇩2',sh⇩2),False⟩ →* ⟨ef,(h⇩3,l⇩3,sh⇩3),b⇩3⟩"
and "final ef"
shows "P ⊢ ⟨C∙⇩sM(es), s⇩0,b⇩0⟩ →* ⟨ef,(h⇩3,l⇩2,sh⇩3),b⇩3⟩"
proof -
have wf: "size Ts = size pns ∧ distinct pns"
and wt: "fv body ⊆ set pns"
using assms by(fastforce dest!:sees_wf_mdecl simp:wf_mdecl_def)+
from body[THEN Red_lcl_add, of l⇩2]
have body': "P ⊢ ⟨body,(h⇩2,l⇩2(pns[↦]vs),sh⇩2),False⟩ →* ⟨ef,(h⇩3,l⇩2++l⇩3,sh⇩3),b⇩3⟩"
by (simp add:l⇩2')
have "dom l⇩3 ⊆ set pns"
using Reds_dom_lcl[OF wwf body] wt l⇩2' set_take_subset by force
hence eql⇩2: "override_on (l⇩2++l⇩3) l⇩2 (set pns) = l⇩2"
by(fastforce simp add:map_add_def override_on_def fun_eq_iff)
have b2T: "P ⊢ ⟨C∙⇩sM(map Val vs), (h⇩2,l⇩2,sh⇩2),b⇩2⟩ →* ⟨C∙⇩sM(map Val vs), (h⇩2,l⇩2,sh⇩2),True⟩"
proof(cases b⇩2)
case True then show ?thesis by simp
next
case False then show ?thesis using assms(3,4) by(auto elim: SCallInitDoneRed)
qed
have "P ⊢ ⟨C∙⇩sM(es),s⇩0,b⇩0⟩ →* ⟨C∙⇩sM(map Val vs),(h⇩2,l⇩2,sh⇩2),b⇩2⟩"
by(rule SCallRedsParams)(rule assms(2))
also have "P ⊢ ⟨C∙⇩sM(map Val vs), (h⇩2,l⇩2,sh⇩2),b⇩2⟩ →* ⟨blocks(pns, Ts, vs, body), (h⇩2,l⇩2,sh⇩2),False⟩"
by(auto intro!: rtrancl_into_rtrancl[OF b2T] RedSCall assms(3) simp: assms wf)
also (rtrancl_trans) have "P ⊢ ⟨blocks(pns, Ts, vs, body), (h⇩2,l⇩2,sh⇩2),False⟩
→* ⟨ef,(h⇩3,override_on (l⇩2++l⇩3) l⇩2 (set pns),sh⇩3),b⇩3⟩"
by(rule blocksRedsFinal, insert assms wf body', simp_all)
finally show ?thesis using eql⇩2 by simp
qed
lemma SCallRedsThrowParams:
"⟦ P ⊢ ⟨es,s⇩0,b⇩0⟩ [→]* ⟨map Val vs⇩1 @ throw a # es⇩2,s⇩2,b⇩2⟩ ⟧
⟹ P ⊢ ⟨C∙⇩sM(es),s⇩0,b⇩0⟩ →* ⟨throw a,s⇩2,b⇩2⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule SCallRedsParams)
apply(rule SCallThrowParams)
apply simp
done
lemma SCallRedsNone:
"⟦ P ⊢ ⟨es,s,b⟩ [→]* ⟨map Val vs,s⇩2,False⟩;
¬(∃b Ts T m D. P ⊢ C sees M,b:Ts→T = m in D) ⟧
⟹ P ⊢ ⟨C∙⇩sM(es),s,b⟩ →* ⟨THROW NoSuchMethodError,s⇩2,False⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule SCallRedsParams)
apply(cases s⇩2,simp)
apply(rule RedSCallNone, simp)
done
lemma SCallRedsNonStatic:
"⟦ P ⊢ ⟨es,s,b⟩ [→]* ⟨map Val vs,s⇩2,False⟩;
P ⊢ C sees M,NonStatic:Ts→T = m in D ⟧
⟹ P ⊢ ⟨C∙⇩sM(es),s,b⟩ →* ⟨THROW IncompatibleClassChangeError,s⇩2,False⟩"
apply(rule rtrancl_into_rtrancl)
apply(erule SCallRedsParams)
apply(cases s⇩2,simp)
apply(rule RedSCallNonStatic, simp)
done
lemma SCallInitThrowReds:
assumes wwf: "wwf_J_prog P"
and "P ⊢ ⟨es,s⇩0,b⇩0⟩ [→]* ⟨map Val vs,(h⇩1,l⇩1,sh⇩1),False⟩"
"P ⊢ C sees M,Static:Ts→T = (pns,body) in D"
"∄sfs. sh⇩1 D = Some(sfs,Done)"
"M ≠ clinit"
and "P ⊢ ⟨INIT D ([D],False) ← unit,(h⇩1,l⇩1,sh⇩1),False⟩ →* ⟨throw a,(h⇩2,l⇩2,sh⇩2),b⇩2⟩"
shows "P ⊢ ⟨C∙⇩sM(es), s⇩0,b⇩0⟩ →* ⟨throw a,(h⇩2,l⇩2,sh⇩2),b⇩2⟩"
proof -
have "P ⊢ ⟨C∙⇩sM(es),s⇩0,b⇩0⟩ →* ⟨C∙⇩sM(map Val vs),(h⇩1,l⇩1,sh⇩1),False⟩"
by(rule SCallRedsParams)(rule assms(2))
also have "P ⊢ ⟨C∙⇩sM(map Val vs),(h⇩1,l⇩1,sh⇩1),False⟩ → ⟨INIT D ([D],False) ← C∙⇩sM(map Val vs),(h⇩1,l⇩1,sh⇩1),False⟩"
using SCallInitRed[OF assms(3)] assms(4-5) by auto
also (rtrancl_into_rtrancl) have "P ⊢ ⟨INIT D ([D],False) ← C∙⇩sM(map Val vs),(h⇩1,l⇩1,sh⇩1),False⟩
→* ⟨throw a,(h⇩2,l⇩2,sh⇩2),b⇩2⟩"
by(rule InitSeqThrowReds[OF assms(6)])
finally show ?thesis by simp
qed
lemma SCallInitReds:
assumes wwf: "wwf_J_prog P"
and "P ⊢ ⟨es,s⇩0,b⇩0⟩ [→]* ⟨map Val vs,(h⇩1,l⇩1,sh⇩1),False⟩"
"P ⊢ C sees M,Static:Ts→T = (pns,body) in D"
"∄sfs. sh⇩1 D = Some(sfs,Done)"
"M ≠ clinit"
and "P ⊢ ⟨INIT D ([D],False) ← unit,(h⇩1,l⇩1,sh⇩1),False⟩ →* ⟨Val v',(h⇩2,l⇩2,sh⇩2),b⇩2⟩"
and "size vs = size pns"
and l⇩2': "l⇩2' = [pns[↦]vs]"
and body: "P ⊢ ⟨body,(h⇩2,l⇩2',sh⇩2),False⟩ →* ⟨ef,(h⇩3,l⇩3,sh⇩3),b⇩3⟩"
and "final ef"
shows "P ⊢ ⟨C∙⇩sM(es),s⇩0,b⇩0⟩ →* ⟨ef,(h⇩3,l⇩2,sh⇩3),b⇩3⟩"
proof -
have wf: "size Ts = size pns ∧ distinct pns"
and wt: "fv body ⊆ set pns"
using assms by(fastforce dest!:sees_wf_mdecl simp:wf_mdecl_def)+
from body[THEN Red_lcl_add, of l⇩2]
have body': "P ⊢ ⟨body,(h⇩2,l⇩2(pns[↦]vs),sh⇩2),False⟩ →* ⟨ef,(h⇩3,l⇩2++l⇩3,sh⇩3),b⇩3⟩"
by (simp add:l⇩2')
have "dom l⇩3 ⊆ set pns"
using Reds_dom_lcl[OF wwf body] wt l⇩2' set_take_subset by force
hence eql⇩2: "override_on (l⇩2++l⇩3) l⇩2 (set pns) = l⇩2"
by(fastforce simp add:map_add_def override_on_def fun_eq_iff)
have "icheck P D (C∙⇩sM(map Val vs)::'a exp)" using assms(3) by auto
then have "P ⊢ ⟨C∙⇩sM(map Val vs),(h⇩2, l⇩2, sh⇩2),icheck P D (C∙⇩sM(map Val vs))⟩
→ ⟨blocks(pns, Ts, vs, body), (h⇩2, l⇩2, sh⇩2), False⟩"
by (metis (full_types) assms(3) assms(7) local.wf red_reds.RedSCall)
also have "P ⊢ ⟨blocks(pns, Ts, vs, body), (h⇩2, l⇩2, sh⇩2), False⟩
→* ⟨ef,(h⇩3,override_on (l⇩2++l⇩3) l⇩2 (set pns),sh⇩3),b⇩3⟩"
by(rule blocksRedsFinal, insert assms wf body', simp_all)
finally have trueReds: "P ⊢ ⟨C∙⇩sM(map Val vs),(h⇩2, l⇩2, sh⇩2),icheck P D (C∙⇩sM(map Val vs))⟩
→* ⟨ef,(h⇩3,override_on (l⇩2++l⇩3) l⇩2 (set pns),sh⇩3),b⇩3⟩" by simp
have "P ⊢ ⟨C∙⇩sM(es),s⇩0,b⇩0⟩ →* ⟨C∙⇩sM(map Val vs),(h⇩1,l⇩1,sh⇩1),False⟩"
by(rule SCallRedsParams)(rule assms(2))
also have "P ⊢ ⟨C∙⇩sM(map Val vs),(h⇩1,l⇩1,sh⇩1),False⟩ → ⟨INIT D ([D],False) ← C∙⇩sM(map Val vs),(h⇩1,l⇩1,sh⇩1),False⟩"
using SCallInitRed[OF assms(3)] assms(4-5) by auto
also (rtrancl_into_rtrancl) have "P ⊢ ⟨INIT D ([D],False) ← C∙⇩sM(map Val vs),(h⇩1,l⇩1,sh⇩1),False⟩
→* ⟨ef,(h⇩3,override_on (l⇩2++l⇩3) l⇩2 (set pns),sh⇩3),b⇩3⟩"
using InitSeqReds[OF assms(6) trueReds] assms(5) by simp
finally show ?thesis using eql⇩2 by simp
qed
lemma SCallInitProcessingReds:
assumes wwf: "wwf_J_prog P"
and "P ⊢ ⟨es,s⇩0,b⇩0⟩ [→]* ⟨map Val vs,(h⇩2,l⇩2,sh⇩2),b⇩2⟩"
"P ⊢ C sees M,Static:Ts→T = (pns,body) in D"
"sh⇩2 D = Some(sfs,Processing)"
and "size vs = size pns"
and l⇩2': "l⇩2' = [pns[↦]vs]"
and body: "P ⊢ ⟨body,(h⇩2,l⇩2',sh⇩2),False⟩ →* ⟨ef,(h⇩3,l⇩3,sh⇩3),b⇩3⟩"
and "final ef"
shows "P ⊢ ⟨C∙⇩sM(es),s⇩0,b⇩0⟩ →* ⟨ef,(h⇩3,l⇩2,sh⇩3),b⇩3⟩"
proof -
have wf: "size Ts = size pns ∧ distinct pns"
and wt: "fv body ⊆ set pns"
using assms by(fastforce dest!:sees_wf_mdecl simp:wf_mdecl_def)+
from body[THEN Red_lcl_add, of l⇩2]
have body': "P ⊢ ⟨body,(h⇩2,l⇩2(pns[↦]vs),sh⇩2),False⟩ →* ⟨ef,(h⇩3,l⇩2++l⇩3,sh⇩3),b⇩3⟩"
by (simp add:l⇩2')
have "dom l⇩3 ⊆ set pns"
using Reds_dom_lcl[OF wwf body] wt l⇩2' set_take_subset by force
hence eql⇩2: "override_on (l⇩2++l⇩3) l⇩2 (set pns) = l⇩2"
by(fastforce simp add:map_add_def override_on_def fun_eq_iff)
have b2T: "P ⊢ ⟨C∙⇩sM(map Val vs), (h⇩2,l⇩2,sh⇩2),b⇩2⟩ →* ⟨C∙⇩sM(map Val vs), (h⇩2,l⇩2,sh⇩2),True⟩"
proof(cases b⇩2)
case True then show ?thesis by simp
next
case False
show ?thesis
proof(cases "M = clinit")
case True then show ?thesis using False assms(3) red_reds.SCallInitDoneRed assms(4)
by (simp add: r_into_rtrancl)
next
case nclinit: False
have icheck: "icheck P D (C∙⇩sM(map Val vs))" using assms(3) by auto
have "P ⊢ ⟨C∙⇩sM(map Val vs),(h⇩2, l⇩2, sh⇩2),b⇩2⟩
→ ⟨INIT D ([D],False) ← C∙⇩sM(map Val vs),(h⇩2, l⇩2, sh⇩2),False⟩"
using SCallInitRed[OF assms(3)] assms(4) False nclinit by simp
also have "P ⊢ ⟨INIT D ([D],False) ← C∙⇩sM(map Val vs),(h⇩2, l⇩2, sh⇩2),False⟩
→ ⟨INIT D (Nil,True) ← C∙⇩sM(map Val vs),(h⇩2, l⇩2, sh⇩2),False⟩"
using RedInitProcessing assms(4) by simp
also have "P ⊢ ⟨INIT D (Nil,True) ← C∙⇩sM(map Val vs),(h⇩2, l⇩2, sh⇩2),False⟩
→ ⟨C∙⇩sM(map Val vs),(h⇩2, l⇩2, sh⇩2),True⟩"
using RedInit[of "C∙⇩sM(map Val vs)" D _ _ _ P] icheck nclinit
by (metis (full_types) nsub_RI_Vals sub_RI.simps(12))
finally show ?thesis by simp
qed
qed
have "P ⊢ ⟨C∙⇩sM(es),s⇩0,b⇩0⟩ →* ⟨C∙⇩sM(map Val vs),(h⇩2,l⇩2,sh⇩2),b⇩2⟩"
by(rule SCallRedsParams)(rule assms(2))
also have "P ⊢ ⟨C∙⇩sM(map Val vs), (h⇩2,l⇩2,sh⇩2),b⇩2⟩ →* ⟨blocks(pns, Ts, vs, body), (h⇩2,l⇩2,sh⇩2),False⟩"
by(auto intro!: rtrancl_into_rtrancl[OF b2T] RedSCall assms(3) simp: assms wf)
also (rtrancl_trans) have "P ⊢ ⟨blocks(pns, Ts, vs, body), (h⇩2,l⇩2,sh⇩2),False⟩
→* ⟨ef,(h⇩3,override_on (l⇩2++l⇩3) l⇩2 (set pns),sh⇩3),b⇩3⟩"
by(rule blocksRedsFinal, insert assms wf body', simp_all)
finally show ?thesis using eql⇩2 by simp
qed
subsubsection "The main Theorem"
lemma assumes wwf: "wwf_J_prog P"
shows big_by_small: "P ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩
⟹ (⋀b. iconf (shp s) e ⟹ P,shp s ⊢⇩b (e,b) √ ⟹ P ⊢ ⟨e,s,b⟩ →* ⟨e',s',False⟩)"
and bigs_by_smalls: "P ⊢ ⟨es,s⟩ [⇒] ⟨es',s'⟩
⟹ (⋀b. iconfs (shp s) es ⟹ P,shp s ⊢⇩b (es,b) √ ⟹ P ⊢ ⟨es,s,b⟩ [→]* ⟨es',s',False⟩)"
proof (induct rule: eval_evals.inducts)
case New show ?case
proof(cases b)
case True then show ?thesis using RedNew[OF New.hyps(2-4)] by auto
next
case False then show ?thesis using New.hyps(1) NewInitDoneReds[OF _ New.hyps(2-4)] by auto
qed
next
case NewFail show ?case
proof(cases b)
case True then show ?thesis using RedNewFail[OF NewFail.hyps(2)] NewFail.hyps(3) by fastforce
next
case False
then show ?thesis using NewInitDoneReds2[OF _ NewFail.hyps(2)] NewFail by fastforce
qed
next
case (NewInit sh C h l v' h' l' sh' a FDTs h'') show ?case
proof(cases b)
case True
then obtain sfs where shC: "sh C = ⌊(sfs, Processing)⌋"
using NewInit.hyps(1) NewInit.prems by(clarsimp simp: bconf_def initPD_def)
then have s': "(h',l',sh') = (h,l,sh)" using NewInit.hyps(2) init_ProcessingE by clarsimp
then show ?thesis using RedNew[OF NewInit.hyps(4-6)] True by auto
next
case False
then have init: "P ⊢ ⟨INIT C ([C],False) ← unit,(h, l, sh),False⟩ →* ⟨Val v',(h', l', sh'),False⟩"
using NewInit.hyps(3) by(auto simp: bconf_def)
then show ?thesis using NewInit NewInitReds[OF _ init NewInit.hyps(4-6)] False
has_fields_is_class[OF NewInit.hyps(5)] by auto
qed
next
case (NewInitOOM sh C h l v' h' l' sh') show ?case
proof(cases b)
case True
then obtain sfs where shC: "sh C = ⌊(sfs, Processing)⌋"
using NewInitOOM.hyps(1) NewInitOOM.prems by(clarsimp simp: bconf_def initPD_def)
then have s': "(h',l',sh') = (h,l,sh)" using NewInitOOM.hyps(2) init_ProcessingE by clarsimp
then show ?thesis using RedNewFail[OF NewInitOOM.hyps(4)] True r_into_rtrancl NewInitOOM.hyps(5)
by auto
next
case False
then have init: "P ⊢ ⟨INIT C ([C],False) ← unit,(h, l, sh),False⟩ →* ⟨Val v',(h', l', sh'),False⟩"
using NewInitOOM.hyps(3) by(auto simp: bconf_def)
then show ?thesis using NewInitOOM.hyps(1) NewInitOOMReds[OF _ init NewInitOOM.hyps(4)] False
NewInitOOM.hyps(5) by auto
qed
next
case (NewInitThrow sh C h l a s') show ?case
proof(cases b)
case True
then obtain sfs where shC: "sh C = ⌊(sfs, Processing)⌋"
using NewInitThrow.hyps(1) NewInitThrow.prems by(clarsimp simp: bconf_def initPD_def)
then show ?thesis using NewInitThrow.hyps(2) init_ProcessingE by blast
next
case False
then have init: "P ⊢ ⟨INIT C ([C],False) ← unit,(h, l, sh),b⟩ →* ⟨throw a,s',False⟩"
using NewInitThrow.hyps(3) by(auto simp: bconf_def)
then show ?thesis using NewInitThrow NewInitThrowReds[of "(h,l,sh)" C P a s'] False by auto
qed
next
case Cast then show ?case by(fastforce intro:CastRedsAddr)
next
case CastNull then show ?case by(fastforce intro: CastRedsNull)
next
case CastFail thus ?case by(fastforce intro!:CastRedsFail)
next
case CastThrow thus ?case by(fastforce dest!:eval_final intro:CastRedsThrow)
next
case Val then show ?case using exI[of _ b] by(simp add: bconf_def)
next
case (BinOp e⇩1 s⇩0 v⇩1 s⇩1 e⇩2 v⇩2 s⇩2 bop v)
show ?case
proof(cases "val_of e⇩1")
case None
then have iconf: "iconf (shp s⇩0) e⇩1" using None BinOp.prems by auto
have bconf: "P,shp s⇩0 ⊢⇩b (e⇩1,b) √" using None BinOp.prems by auto
then have b1: "P ⊢ ⟨e⇩1,s⇩0,b⟩ →* ⟨Val v⇩1,s⇩1,False⟩" using iconf BinOp.hyps(2) by auto
have binop: "P ⊢ ⟨e⇩1 «bop» e⇩2,s⇩0,b⟩ →* ⟨Val v⇩1 «bop» e⇩2,s⇩1,False⟩" by(rule BinOp1Reds[OF b1])
then have iconf2': "iconf (shp s⇩1) e⇩2" using Red_preserves_iconf[OF wwf binop] None BinOp by auto
have "P,shp s⇩1 ⊢⇩b (e⇩2,False) √" by(simp add: bconf_def)
then have b2: "P ⊢ ⟨e⇩2,s⇩1,False⟩ →* ⟨Val v⇩2,s⇩2,False⟩" using BinOp.hyps(4)[OF iconf2'] by auto
then show ?thesis using BinOpRedsVal[OF b1 b2 BinOp.hyps(5)] by fast
next
case (Some a)
then obtain b1 where b1: "P ⊢ ⟨e⇩1,s⇩0,b⟩ →* ⟨Val v⇩1,s⇩1,b1⟩"
by (metis (no_types, lifting) BinOp.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
have binop: "P ⊢ ⟨e⇩1 «bop» e⇩2,s⇩0,b⟩ →* ⟨Val v⇩1 «bop» e⇩2,s⇩1,b1⟩" by(rule BinOp1Reds[OF b1])
then have iconf2': "iconf (shp s⇩1) e⇩2" using Red_preserves_iconf[OF wwf binop] BinOp by auto
have bconf2: "P,shp s⇩0 ⊢⇩b (e⇩2,b) √" using BinOp.prems Some by simp
then have "P,shp s⇩1 ⊢⇩b (e⇩2,b1) √" using Red_preserves_bconf[OF wwf binop BinOp.prems] by simp
then have b2: "P ⊢ ⟨e⇩2,s⇩1,b1⟩ →* ⟨Val v⇩2,s⇩2,False⟩" using BinOp.hyps(4)[OF iconf2'] by auto
then show ?thesis using BinOpRedsVal[OF b1 b2 BinOp.hyps(5)] by fast
qed
next
case (BinOpThrow1 e⇩1 s⇩0 e s⇩1 bop e⇩2) show ?case
proof(cases "val_of e⇩1")
case None
then have "iconf (shp s⇩0) e⇩1" and "P,shp s⇩0 ⊢⇩b (e⇩1,b) √" using BinOpThrow1.prems by auto
then have b1: "P ⊢ ⟨e⇩1,s⇩0,b⟩ →* ⟨throw e,s⇩1,False⟩" using BinOpThrow1.hyps(2) by auto
then have "P ⊢ ⟨e⇩1 «bop» e⇩2,s⇩0,b⟩ →* ⟨throw e,s⇩1,False⟩"
using BinOpThrow1 None by(auto dest!:eval_final simp: BinOpRedsThrow1[OF b1])
then show ?thesis by fast
next
case (Some a)
then show ?thesis using eval_final_same[OF BinOpThrow1.hyps(1)] val_of_spec[OF Some] by auto
qed
next
case (BinOpThrow2 e⇩1 s⇩0 v⇩1 s⇩1 e⇩2 e s⇩2 bop)
show ?case
proof(cases "val_of e⇩1")
case None
then have iconf: "iconf (shp s⇩0) e⇩1" using None BinOpThrow2.prems by auto
have bconf: "P,shp s⇩0 ⊢⇩b (e⇩1,b) √" using None BinOpThrow2.prems by auto
then have b1: "P ⊢ ⟨e⇩1,s⇩0,b⟩ →* ⟨Val v⇩1,s⇩1,False⟩" using iconf BinOpThrow2.hyps(2) by auto
have binop: "P ⊢ ⟨e⇩1 «bop» e⇩2,s⇩0,b⟩ →* ⟨Val v⇩1 «bop» e⇩2,s⇩1,False⟩" by(rule BinOp1Reds[OF b1])
then have iconf2': "iconf (shp s⇩1) e⇩2" using Red_preserves_iconf[OF wwf binop] None BinOpThrow2 by auto
have "P,shp s⇩1 ⊢⇩b (e⇩2,False) √" by(simp add: bconf_def)
then have b2: "P ⊢ ⟨e⇩2,s⇩1,False⟩ →* ⟨throw e,s⇩2,False⟩" using BinOpThrow2.hyps(4)[OF iconf2'] by auto
then show ?thesis using BinOpRedsThrow2[OF b1 b2] by fast
next
case (Some a)
then obtain b1 where b1: "P ⊢ ⟨e⇩1,s⇩0,b⟩ →* ⟨Val v⇩1,s⇩1,b1⟩"
by (metis (no_types, lifting) BinOpThrow2.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
have binop: "P ⊢ ⟨e⇩1 «bop» e⇩2,s⇩0,b⟩ →* ⟨Val v⇩1 «bop» e⇩2,s⇩1,b1⟩" by(rule BinOp1Reds[OF b1])
then have iconf2': "iconf (shp s⇩1) e⇩2" using Red_preserves_iconf[OF wwf binop] BinOpThrow2 by auto
have bconf2: "P,shp s⇩0 ⊢⇩b (e⇩2,b) √" using BinOpThrow2.prems Some by simp
then have "P,shp s⇩1 ⊢⇩b (e⇩2,b1) √" using Red_preserves_bconf[OF wwf binop BinOpThrow2.prems] by simp
then have b2: "P ⊢ ⟨e⇩2,s⇩1,b1⟩ →* ⟨throw e,s⇩2,False⟩" using BinOpThrow2.hyps(4)[OF iconf2'] by auto
then show ?thesis using BinOpRedsThrow2[OF b1 b2] by fast
qed
next
case Var thus ?case by(auto dest:RedVar simp: bconf_def)
next
case LAss thus ?case by(auto dest: LAssRedsVal)
next
case LAssThrow thus ?case by(auto dest!:eval_final dest: LAssRedsThrow)
next
case FAcc thus ?case by(fastforce intro:FAccRedsVal)
next
case FAccNull thus ?case by(auto dest:FAccRedsNull)
next
case FAccThrow thus ?case by(auto dest!:eval_final dest:FAccRedsThrow)
next
case FAccNone then show ?case by(fastforce intro: FAccRedsNone)
next
case FAccStatic then show ?case by(fastforce intro: FAccRedsStatic)
next
case SFAcc show ?case
proof(cases b)
case True then show ?thesis using RedSFAcc SFAcc.hyps by auto
next
case False then show ?thesis using SFAcc.hyps SFAccInitDoneReds[OF SFAcc.hyps(1)] by auto
qed
next
case (SFAccInit C F t D sh h l v' h' l' sh' sfs i v) show ?case
proof(cases b)
case True
then obtain sfs where shC: "sh D = ⌊(sfs, Processing)⌋"
using SFAccInit.hyps(2) SFAccInit.prems by(clarsimp simp: bconf_def initPD_def)
then have s': "(h',l',sh') = (h,l,sh)" using SFAccInit.hyps(3) init_ProcessingE by clarsimp
then show ?thesis using RedSFAcc SFAccInit.hyps True by auto
next
case False
then have init: "P ⊢ ⟨INIT D ([D],False) ← unit,(h, l, sh),False⟩ →* ⟨Val v',(h', l', sh'),False⟩"
using SFAccInit.hyps(4) by(auto simp: bconf_def)
then show ?thesis using SFAccInit SFAccInitReds[OF _ _ init] False by auto
qed
next
case (SFAccInitThrow C F t D sh h l a s') show ?case
proof(cases b)
case True
then obtain sfs where shC: "sh D = ⌊(sfs, Processing)⌋"
using SFAccInitThrow.hyps(2) SFAccInitThrow.prems(2) by(clarsimp simp: bconf_def initPD_def)
then show ?thesis using SFAccInitThrow.hyps(3) init_ProcessingE by blast
next
case False
then have init: "P ⊢ ⟨INIT D ([D],False) ← unit,(h, l, sh),b⟩ →* ⟨throw a,s',False⟩"
using SFAccInitThrow.hyps(4) by(auto simp: bconf_def)
then show ?thesis using SFAccInitThrow SFAccInitThrowReds False by auto
qed
next
case SFAccNone then show ?case by(fastforce intro: SFAccRedsNone)
next
case SFAccNonStatic then show ?case by(fastforce intro: SFAccRedsNonStatic)
next
case (FAss e⇩1 s⇩0 a s⇩1 e⇩2 v h⇩2 l⇩2 sh⇩2 C fs F t D fs' h⇩2')
show ?case
proof(cases "val_of e⇩1")
case None
then have iconf: "iconf (shp s⇩0) e⇩1" using None FAss.prems by auto
have bconf: "P,shp s⇩0 ⊢⇩b (e⇩1,b) √" using None FAss.prems by auto
then have b1: "P ⊢ ⟨e⇩1,s⇩0,b⟩ →* ⟨addr a,s⇩1,False⟩" using iconf FAss.hyps(2) by auto
have fass: "P ⊢ ⟨e⇩1∙F{D} := e⇩2,s⇩0,b⟩ →* ⟨addr a∙F{D} := e⇩2,s⇩1,False⟩" by(rule FAssReds1[OF b1])
then have iconf2': "iconf (shp s⇩1) e⇩2" using Red_preserves_iconf[OF wwf fass] None FAss by auto
have "P,shp s⇩1 ⊢⇩b (e⇩2,False) √" by(simp add: bconf_def)
then have b2: "P ⊢ ⟨e⇩2,s⇩1,False⟩ →* ⟨Val v,(h⇩2, l⇩2, sh⇩2),False⟩" using FAss.hyps(4)[OF iconf2'] by auto
then show ?thesis using FAssRedsVal[OF b1 b2 FAss.hyps(6) FAss.hyps(5)[THEN sym]] FAss.hyps(7,8) by fast
next
case (Some a')
then obtain b1 where b1: "P ⊢ ⟨e⇩1,s⇩0,b⟩ →* ⟨addr a,s⇩1,b1⟩"
by (metis (no_types, lifting) FAss.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
have fass: "P ⊢ ⟨e⇩1∙F{D} := e⇩2,s⇩0,b⟩ →* ⟨addr a∙F{D} := e⇩2,s⇩1,b1⟩" by(rule FAssReds1[OF b1])
then have iconf2': "iconf (shp s⇩1) e⇩2" using Red_preserves_iconf[OF wwf fass] FAss by auto
have bconf2: "P,shp s⇩0 ⊢⇩b (e⇩2,b) √" using FAss.prems Some by simp
then have "P,shp s⇩1 ⊢⇩b (e⇩2,b1) √" using Red_preserves_bconf[OF wwf fass FAss.prems] by simp
then have b2: "P ⊢ ⟨e⇩2,s⇩1,b1⟩ →* ⟨Val v,(h⇩2, l⇩2, sh⇩2),False⟩" using FAss.hyps(4)[OF iconf2'] by auto
then show ?thesis using FAssRedsVal[OF b1 b2] FAss.hyps(5)[THEN sym] FAss.hyps(6-8) by fast
qed
next
case (FAssNull e⇩1 s⇩0 s⇩1 e⇩2 v s⇩2 F D)
show ?case
proof(cases "val_of e⇩1")
case None
then have iconf: "iconf (shp s⇩0) e⇩1" using FAssNull.prems(1) by simp
have bconf: "P,shp s⇩0 ⊢⇩b (e⇩1,b) √" using FAssNull.prems(2) None by simp
then have b1: "P ⊢ ⟨e⇩1,s⇩0,b⟩ →* ⟨null,s⇩1,False⟩" using FAssNull.hyps(2)[OF iconf] by auto
have fass: "P ⊢ ⟨e⇩1∙F{D} := e⇩2,s⇩0,b⟩ →* ⟨null∙F{D} := e⇩2,s⇩1,False⟩" by(rule FAssReds1[OF b1])
then have iconf2': "iconf (shp s⇩1) e⇩2" using Red_preserves_iconf[OF wwf fass] None FAssNull by auto
have "P,shp s⇩1 ⊢⇩b (e⇩2,False) √" by(simp add: bconf_def)
then have b2: "P ⊢ ⟨e⇩2,s⇩1,False⟩ →* ⟨Val v,s⇩2,False⟩" using FAssNull.hyps(4)[OF iconf2'] by auto
then show ?thesis using FAssRedsNull[OF b1 b2] by fast
next
case (Some a')
then obtain b1 where b1: "P ⊢ ⟨e⇩1,s⇩0,b⟩ →* ⟨null,s⇩1,b1⟩"
by (metis (no_types, lifting) FAssNull.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
have fass: "P ⊢ ⟨e⇩1∙F{D} := e⇩2,s⇩0,b⟩ →* ⟨null∙F{D} := e⇩2,s⇩1,b1⟩" by(rule FAssReds1[OF b1])
then have iconf2': "iconf (shp s⇩1) e⇩2" using Red_preserves_iconf[OF wwf fass] FAssNull by auto
have bconf2: "P,shp s⇩0 ⊢⇩b (e⇩2,b) √" using FAssNull.prems Some by simp
then have "P,shp s⇩1 ⊢⇩b (e⇩2,b1) √" using Red_preserves_bconf[OF wwf fass FAssNull.prems] by simp
then have b2: "P ⊢ ⟨e⇩2,s⇩1,b1⟩ →* ⟨Val v,s⇩2,False⟩" using FAssNull.hyps(4)[OF iconf2'] by auto
then show ?thesis using FAssRedsNull[OF b1 b2] by fast
qed
next
case (FAssThrow1 e⇩1 s⇩0 e' s⇩1 F D e⇩2) show ?case
proof(cases "val_of e⇩1")
case None
then have "iconf (shp s⇩0) e⇩1" and "P,shp s⇩0 ⊢⇩b (e⇩1,b) √" using FAssThrow1.prems by auto
then have b1: "P ⊢ ⟨e⇩1,s⇩0,b⟩ →* ⟨throw e',s⇩1,False⟩" using FAssThrow1.hyps(2) by auto
then have "P ⊢ ⟨e⇩1∙F{D} := e⇩2,s⇩0,b⟩ →* ⟨throw e',s⇩1,False⟩"
using FAssThrow1 None by(auto dest!:eval_final simp: FAssRedsThrow1[OF b1])
then show ?thesis by fast
next
case (Some a)
then show ?thesis using eval_final_same[OF FAssThrow1.hyps(1)] val_of_spec[OF Some] by auto
qed
next
case (FAssThrow2 e⇩1 s⇩0 v s⇩1 e⇩2 e' s⇩2 F D)
show ?case
proof(cases "val_of e⇩1")
case None
then have iconf: "iconf (shp s⇩0) e⇩1" using None FAssThrow2.prems by auto
have bconf: "P,shp s⇩0 ⊢⇩b (e⇩1,b) √" using None FAssThrow2.prems by auto
then have b1: "P ⊢ ⟨e⇩1,s⇩0,b⟩ →* ⟨Val v,s⇩1,False⟩" using iconf FAssThrow2.hyps(2) by auto
have fass: "P ⊢ ⟨e⇩1∙F{D} := e⇩2,s⇩0,b⟩ →* ⟨Val v∙F{D} := e⇩2,s⇩1,False⟩" by(rule FAssReds1[OF b1])
then have iconf2': "iconf (shp s⇩1) e⇩2" using Red_preserves_iconf[OF wwf fass] None FAssThrow2 by auto
have "P,shp s⇩1 ⊢⇩b (e⇩2,False) √" by(simp add: bconf_def)
then have b2: "P ⊢ ⟨e⇩2,s⇩1,False⟩ →* ⟨throw e',s⇩2,False⟩" using FAssThrow2.hyps(4)[OF iconf2'] by auto
then show ?thesis using FAssRedsThrow2[OF b1 b2] by fast
next
case (Some a')
then obtain b1 where b1: "P ⊢ ⟨e⇩1,s⇩0,b⟩ →* ⟨Val v,s⇩1,b1⟩"
by (metis (no_types, lifting) FAssThrow2.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
have fass: "P ⊢ ⟨e⇩1∙F{D} := e⇩2,s⇩0,b⟩ →* ⟨Val v∙F{D} := e⇩2,s⇩1,b1⟩" by(rule FAssReds1[OF b1])
then have iconf2': "iconf (shp s⇩1) e⇩2" using Red_preserves_iconf[OF wwf fass] FAssThrow2 by auto
have bconf2: "P,shp s⇩0 ⊢⇩b (e⇩2,b) √" using FAssThrow2.prems Some by simp
then have "P,shp s⇩1 ⊢⇩b (e⇩2,b1) √" using Red_preserves_bconf[OF wwf fass FAssThrow2.prems] by simp
then have b2: "P ⊢ ⟨e⇩2,s⇩1,b1⟩ →* ⟨throw e',s⇩2,False⟩" using FAssThrow2.hyps(4)[OF iconf2'] by auto
then show ?thesis using FAssRedsThrow2[OF b1 b2] by fast
qed
next
case (FAssNone e⇩1 s⇩0 a s⇩1 e⇩2 v h⇩2 l⇩2 sh⇩2 C fs F D)
show ?case
proof(cases "val_of e⇩1")
case None
then have iconf: "iconf (shp s⇩0) e⇩1" using None FAssNone.prems by auto
have bconf: "P,shp s⇩0 ⊢⇩b (e⇩1,b) √" using None FAssNone.prems by auto
then have b1: "P ⊢ ⟨e⇩1,s⇩0,b⟩ →* ⟨addr a,s⇩1,False⟩" using iconf FAssNone.hyps(2) by auto
have fass: "P ⊢ ⟨e⇩1∙F{D} := e⇩2,s⇩0,b⟩ →* ⟨addr a∙F{D} := e⇩2,s⇩1,False⟩" by(rule FAssReds1[OF b1])
then have iconf2': "iconf (shp s⇩1) e⇩2" using Red_preserves_iconf[OF wwf fass] None FAssNone by auto
have "P,shp s⇩1 ⊢⇩b (e⇩2,False) √" by(simp add: bconf_def)
then have b2: "P ⊢ ⟨e⇩2,s⇩1,False⟩ →* ⟨Val v,(h⇩2, l⇩2, sh⇩2),False⟩" using FAssNone.hyps(4)[OF iconf2'] by auto
then show ?thesis using FAssRedsNone[OF b1 b2 FAssNone.hyps(5,6)] by fast
next
case (Some a')
then obtain b1 where b1: "P ⊢ ⟨e⇩1,s⇩0,b⟩ →* ⟨addr a,s⇩1,b1⟩"
by (metis (no_types, lifting) FAssNone.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
have fass: "P ⊢ ⟨e⇩1∙F{D} := e⇩2,s⇩0,b⟩ →* ⟨addr a∙F{D} := e⇩2,s⇩1,b1⟩" by(rule FAssReds1[OF b1])
then have iconf2': "iconf (shp s⇩1) e⇩2" using Red_preserves_iconf[OF wwf fass] FAssNone by auto
have bconf2: "P,shp s⇩0 ⊢⇩b (e⇩2,b) √" using FAssNone.prems Some by simp
then have "P,shp s⇩1 ⊢⇩b (e⇩2,b1) √" using Red_preserves_bconf[OF wwf fass FAssNone.prems] by simp
then have b2: "P ⊢ ⟨e⇩2,s⇩1,b1⟩ →* ⟨Val v,(h⇩2, l⇩2, sh⇩2),False⟩" using FAssNone.hyps(4)[OF iconf2'] by auto
then show ?thesis using FAssRedsNone[OF b1 b2 FAssNone.hyps(5,6)] by fast
qed
next
case (FAssStatic e⇩1 s⇩0 a s⇩1 e⇩2 v h⇩2 l⇩2 sh⇩2 C fs F t D)
show ?case
proof(cases "val_of e⇩1")
case None
then have iconf: "iconf (shp s⇩0) e⇩1" using None FAssStatic.prems by auto
have bconf: "P,shp s⇩0 ⊢⇩b (e⇩1,b) √" using None FAssStatic.prems by auto
then have b1: "P ⊢ ⟨e⇩1,s⇩0,b⟩ →* ⟨addr a,s⇩1,False⟩" using iconf FAssStatic.hyps(2) by auto
have fass: "P ⊢ ⟨e⇩1∙F{D} := e⇩2,s⇩0,b⟩ →* ⟨addr a∙F{D} := e⇩2,s⇩1,False⟩" by(rule FAssReds1[OF b1])
then have iconf2': "iconf (shp s⇩1) e⇩2" using Red_preserves_iconf[OF wwf fass] None FAssStatic by auto
have "P,shp s⇩1 ⊢⇩b (e⇩2,False) √" by(simp add: bconf_def)
then have b2: "P ⊢ ⟨e⇩2,s⇩1,False⟩ →* ⟨Val v,(h⇩2, l⇩2, sh⇩2),False⟩" using FAssStatic.hyps(4)[OF iconf2'] by auto
then show ?thesis using FAssRedsStatic[OF b1 b2 FAssStatic.hyps(5,6)] by fast
next
case (Some a')
then obtain b1 where b1: "P ⊢ ⟨e⇩1,s⇩0,b⟩ →* ⟨addr a,s⇩1,b1⟩"
by (metis (no_types, lifting) FAssStatic.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
have fass: "P ⊢ ⟨e⇩1∙F{D} := e⇩2,s⇩0,b⟩ →* ⟨addr a∙F{D} := e⇩2,s⇩1,b1⟩" by(rule FAssReds1[OF b1])
then have iconf2': "iconf (shp s⇩1) e⇩2" using Red_preserves_iconf[OF wwf fass] FAssStatic by auto
have bconf2: "P,shp s⇩0 ⊢⇩b (e⇩2,b) √" using FAssStatic.prems Some by simp
then have "P,shp s⇩1 ⊢⇩b (e⇩2,b1) √" using Red_preserves_bconf[OF wwf fass FAssStatic.prems] by simp
then have b2: "P ⊢ ⟨e⇩2,s⇩1,b1⟩ →* ⟨Val v,(h⇩2, l⇩2, sh⇩2),False⟩" using FAssStatic.hyps(4)[OF iconf2'] by auto
then show ?thesis using FAssRedsStatic[OF b1 b2 FAssStatic.hyps(5,6)] by fast
qed
next
case (SFAss e⇩2 s⇩0 v h⇩1 l⇩1 sh⇩1 C F t D sfs sfs' sh⇩1')
show ?case
proof(cases "val_of e⇩2")
case None
then have bconf: "P,shp s⇩0 ⊢⇩b (e⇩2,b) √" using SFAss.prems(2) by simp
then have b1: "P ⊢ ⟨e⇩2,s⇩0,b⟩ →* ⟨Val v,(h⇩1, l⇩1, sh⇩1),False⟩" using SFAss by auto
thus ?thesis using SFAssRedsVal[OF b1 SFAss.hyps(3,4)] SFAss.hyps(5,6) by fast
next
case (Some a)
then obtain b1 where b1: "P ⊢ ⟨e⇩2,s⇩0,b⟩ →* ⟨Val v,(h⇩1, l⇩1, sh⇩1),b1⟩"
by (metis (no_types, lifting) SFAss.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
thus ?thesis using SFAssRedsVal[OF b1 SFAss.hyps(3,4)] SFAss.hyps(5,6) by fast
qed
next
case (SFAssInit e⇩2 s⇩0 v h⇩1 l⇩1 sh⇩1 C F t D v' h' l' sh' sfs i sfs' sh'')
then have iconf: "iconf (shp s⇩0) e⇩2" by simp
show ?case
proof(cases "val_of e⇩2")
case None
then have bconf: "P,shp s⇩0 ⊢⇩b (e⇩2,b) √" using SFAssInit.prems(2) by simp
then have reds: "P ⊢ ⟨e⇩2,s⇩0,b⟩ →* ⟨Val v,(h⇩1, l⇩1, sh⇩1),False⟩"
using SFAssInit.hyps(2)[OF iconf bconf] by auto
then have init: "P ⊢ ⟨INIT D ([D],False) ← unit,(h⇩1, l⇩1, sh⇩1),False⟩ →* ⟨Val v',(h', l', sh'),False⟩"
using SFAssInit.hyps(6) by(auto simp: bconf_def)
then show ?thesis using SFAssInit SFAssInitReds[OF reds SFAssInit.hyps(3) _ init] by auto
next
case (Some v2) show ?thesis
proof(cases b)
case False
then have bconf: "P,shp s⇩0 ⊢⇩b (e⇩2,b) √" by(simp add: bconf_def)
then have reds: "P ⊢ ⟨e⇩2,s⇩0,b⟩ →* ⟨Val v,(h⇩1, l⇩1, sh⇩1),False⟩"
using SFAssInit.hyps(2)[OF iconf bconf] by auto
then have init: "P ⊢ ⟨INIT D ([D],False) ← unit,(h⇩1, l⇩1, sh⇩1),False⟩ →* ⟨Val v',(h', l', sh'),False⟩"
using SFAssInit.hyps(6) by(auto simp: bconf_def)
then show ?thesis using SFAssInit SFAssInitReds[OF reds SFAssInit.hyps(3) _ init] by auto
next
case True
have e⇩2: "e⇩2 = Val v2" using val_of_spec[OF Some] by simp
then have vs: "v2 = v ∧ s⇩0 = (h⇩1, l⇩1, sh⇩1)" using eval_final_same[OF SFAssInit.hyps(1)] by simp
then obtain sfs where shC: "sh⇩1 D = ⌊(sfs, Processing)⌋"
using SFAssInit.hyps(3,4) SFAssInit.prems(2) Some True
by(cases e⇩2, auto simp: bconf_def initPD_def dest: sees_method_fun)
then have s': "(h',l',sh') = (h⇩1, l⇩1, sh⇩1)" using SFAssInit.hyps(5) init_ProcessingE by clarsimp
then show ?thesis using SFAssInit.hyps(3,7-9) True e⇩2 red_reds.RedSFAss vs by auto
qed
qed
next
case (SFAssInitThrow e⇩2 s⇩0 v h⇩1 l⇩1 sh⇩1 C F t D a s')
then have iconf: "iconf (shp s⇩0) e⇩2" by simp
show ?case
proof(cases "val_of e⇩2")
case None
then have bconf: "P,shp s⇩0 ⊢⇩b (e⇩2,b) √" using SFAssInitThrow.prems(2) by simp
then have reds: "P ⊢ ⟨e⇩2,s⇩0,b⟩ →* ⟨Val v,(h⇩1, l⇩1, sh⇩1),False⟩"
using SFAssInitThrow.hyps(2)[OF iconf bconf] by auto
then have init: "P ⊢ ⟨INIT D ([D],False) ← unit,(h⇩1, l⇩1, sh⇩1),False⟩ →* ⟨throw a,s',False⟩"
using SFAssInitThrow.hyps(6) by(auto simp: bconf_def)
then show ?thesis using SFAssInitThrow SFAssInitThrowReds[OF reds _ _ init] by auto
next
case (Some v2) show ?thesis
proof(cases b)
case False
then have bconf: "P,shp s⇩0 ⊢⇩b (e⇩2,b) √" by(simp add: bconf_def)
then have reds: "P ⊢ ⟨e⇩2,s⇩0,b⟩ →* ⟨Val v,(h⇩1, l⇩1, sh⇩1),False⟩"
using SFAssInitThrow.hyps(2)[OF iconf bconf] by auto
then have init: "P ⊢ ⟨INIT D ([D],False) ← unit,(h⇩1, l⇩1, sh⇩1),False⟩ →* ⟨throw a,s',False⟩"
using SFAssInitThrow.hyps(6) by(auto simp: bconf_def)
then show ?thesis using SFAssInitThrow SFAssInitThrowReds[OF reds _ _ init] by auto
next
case True
obtain v2 where e⇩2: "e⇩2 = Val v2" using val_of_spec[OF Some] by simp
then have vs: "v2 = v ∧ s⇩0 = (h⇩1, l⇩1, sh⇩1)"
using eval_final_same[OF SFAssInitThrow.hyps(1)] by simp
then obtain sfs where shC: "sh⇩1 D = ⌊(sfs, Processing)⌋"
using SFAssInitThrow.hyps(4) SFAssInitThrow.prems(2) Some True
by(cases e⇩2, auto simp: bconf_def initPD_def dest: sees_method_fun)
then show ?thesis using SFAssInitThrow.hyps(5) init_ProcessingE by blast
qed
qed
next
case (SFAssThrow e⇩2 s⇩0 e' s⇩2 C F D)
show ?case
proof(cases "val_of e⇩2")
case None
then have bconf: "P,shp s⇩0 ⊢⇩b (e⇩2,b) √" using SFAssThrow.prems(2) None by simp
then have b1: "P ⊢ ⟨e⇩2,s⇩0,b⟩ →* ⟨throw e',s⇩2,False⟩" using SFAssThrow by auto
thus ?thesis using SFAssRedsThrow[OF b1] by fast
next
case (Some a)
then show ?thesis using eval_final_same[OF SFAssThrow.hyps(1)] val_of_spec[OF Some] by auto
qed
next
case (SFAssNone e⇩2 s⇩0 v h⇩2 l⇩2 sh⇩2 C F D)
show ?case
proof(cases "val_of e⇩2")
case None
then have iconf: "iconf (shp s⇩0) e⇩2" using SFAssNone by simp
then have bconf: "P,shp s⇩0 ⊢⇩b (e⇩2,b) √" using SFAssNone.prems(2) None by simp
then have b1: "P ⊢ ⟨e⇩2,s⇩0,b⟩ →* ⟨Val v,(h⇩2, l⇩2, sh⇩2),False⟩" using SFAssNone.hyps(2) iconf by auto
thus ?thesis using SFAssRedsNone[OF b1 SFAssNone.hyps(3)] by fast
next
case (Some a)
then obtain b1 where b1: "P ⊢ ⟨e⇩2,s⇩0,b⟩ →* ⟨Val v,(h⇩2, l⇩2, sh⇩2),b1⟩"
by (metis (no_types, lifting) SFAssNone.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
thus ?thesis using SFAssRedsNone[OF b1 SFAssNone.hyps(3)] by fast
qed
next
case (SFAssNonStatic e⇩2 s⇩0 v h⇩2 l⇩2 sh⇩2 C F t D) show ?case
proof(cases "val_of e⇩2")
case None
then have iconf: "iconf (shp s⇩0) e⇩2" using SFAssNonStatic by simp
then have bconf: "P,shp s⇩0 ⊢⇩b (e⇩2,b) √" using SFAssNonStatic.prems(2) None by simp
then have b1: "P ⊢ ⟨e⇩2,s⇩0,b⟩ →* ⟨Val v,(h⇩2, l⇩2, sh⇩2),False⟩" using SFAssNonStatic.hyps(2) iconf by auto
thus ?thesis using SFAssRedsNonStatic[OF b1 SFAssNonStatic.hyps(3)] by fast
next
case (Some a)
then obtain b' where b1: "P ⊢ ⟨e⇩2,s⇩0,b⟩ →* ⟨Val v,(h⇩2, l⇩2, sh⇩2),b'⟩"
by (metis (no_types, lifting) SFAssNonStatic.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
thus ?thesis using SFAssRedsNonStatic[OF b1 SFAssNonStatic.hyps(3)] by fast
qed
next
case (CallObjThrow e s⇩0 e' s⇩1 M ps) show ?case
proof(cases "val_of e")
case None
then have "iconf (shp s⇩0) e" and "P,shp s⇩0 ⊢⇩b (e,b) √" using CallObjThrow.prems by auto
then have b1: "P ⊢ ⟨e,s⇩0,b⟩ →* ⟨throw e',s⇩1,False⟩" using CallObjThrow.hyps(2) by auto
then have "P ⊢ ⟨e∙M(ps),s⇩0,b⟩ →* ⟨throw e',s⇩1,False⟩"
using CallObjThrow None by(auto dest!:eval_final simp: CallRedsThrowObj[OF b1])
then show ?thesis by fast
next
case (Some a)
then show ?thesis using eval_final_same[OF CallObjThrow.hyps(1)] val_of_spec[OF Some] by auto
qed
next
case (CallNull e s⇩0 s⇩1 ps vs s⇩2 M) show ?case
proof(cases "val_of e")
case None
then have iconf: "iconf (shp s⇩0) e" using CallNull.prems(1) by simp
have bconf: "P,shp s⇩0 ⊢⇩b (e,b) √" using CallNull.prems(2) None by simp
then have b1: "P ⊢ ⟨e,s⇩0,b⟩ →* ⟨null,s⇩1,False⟩" using CallNull.hyps(2)[OF iconf] by auto
have call: "P ⊢ ⟨e∙M(ps),s⇩0,b⟩ →* ⟨null∙M(ps),s⇩1,False⟩" by(rule CallRedsObj[OF b1])
then have iconf2': "iconfs (shp s⇩1) ps" using Red_preserves_iconf[OF wwf call] None CallNull by auto
have "P,shp s⇩1 ⊢⇩b (ps,False) √" by(simp add: bconfs_def)
then have b2: "P ⊢ ⟨ps,s⇩1,False⟩ [→]* ⟨map Val vs,s⇩2,False⟩" using CallNull.hyps(4)[OF iconf2'] by auto
then show ?thesis using CallRedsNull[OF b1 b2] by fast
next
case (Some a')
then obtain b1 where b1: "P ⊢ ⟨e,s⇩0,b⟩ →* ⟨null,s⇩1,b1⟩"
by (metis (no_types, lifting) CallNull.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
have fass: "P ⊢ ⟨e∙M(ps),s⇩0,b⟩ →* ⟨null∙M(ps),s⇩1,b1⟩" by(rule CallRedsObj[OF b1])
then have iconf2': "iconfs (shp s⇩1) ps" using Red_preserves_iconf[OF wwf fass] CallNull by auto
have bconf2: "P,shp s⇩0 ⊢⇩b (ps,b) √" using CallNull.prems Some by simp
then have "P,shp s⇩1 ⊢⇩b (ps,b1) √" using Red_preserves_bconf[OF wwf fass CallNull.prems] by simp
then have b2: "P ⊢ ⟨ps,s⇩1,b1⟩ [→]* ⟨map Val vs,s⇩2,False⟩" using CallNull.hyps(4)[OF iconf2'] by auto
then show ?thesis using CallRedsNull[OF b1 b2] by fast
qed
next
case (CallParamsThrow e s⇩0 v s⇩1 es vs ex es' s⇩2 M) show ?case
proof(cases "val_of e")
case None
then have iconf: "iconf (shp s⇩0) e" using CallParamsThrow.prems(1) by simp
have bconf: "P,shp s⇩0 ⊢⇩b (e,b) √" using CallParamsThrow.prems(2) None by simp
then have b1: "P ⊢ ⟨e,s⇩0,b⟩ →* ⟨Val v,s⇩1,False⟩" using CallParamsThrow.hyps(2)[OF iconf] by auto
have call: "P ⊢ ⟨e∙M(es),s⇩0,b⟩ →* ⟨Val v∙M(es),s⇩1,False⟩" by(rule CallRedsObj[OF b1])
then have iconf2': "iconfs (shp s⇩1) es" using Red_preserves_iconf[OF wwf call] None CallParamsThrow by auto
have "P,shp s⇩1 ⊢⇩b (es,False) √" by(simp add: bconfs_def)
then have b2: "P ⊢ ⟨es,s⇩1,False⟩ [→]* ⟨map Val vs @ throw ex # es',s⇩2,False⟩"
using CallParamsThrow.hyps(4)[OF iconf2'] by auto
then show ?thesis using CallRedsThrowParams[OF b1 b2] by fast
next
case (Some a')
then obtain b1 where b1: "P ⊢ ⟨e,s⇩0,b⟩ →* ⟨Val v,s⇩1,b1⟩"
by (metis (no_types, lifting) CallParamsThrow.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
have fass: "P ⊢ ⟨e∙M(es),s⇩0,b⟩ →* ⟨Val v∙M(es),s⇩1,b1⟩" by(rule CallRedsObj[OF b1])
then have iconf2': "iconfs (shp s⇩1) es" using Red_preserves_iconf[OF wwf fass] CallParamsThrow by auto
have bconf2: "P,shp s⇩0 ⊢⇩b (es,b) √" using CallParamsThrow.prems Some by simp
then have "P,shp s⇩1 ⊢⇩b (es,b1) √" using Red_preserves_bconf[OF wwf fass CallParamsThrow.prems] by simp
then have b2: "P ⊢ ⟨es,s⇩1,b1⟩ [→]* ⟨map Val vs @ throw ex # es',s⇩2,False⟩"
using CallParamsThrow.hyps(4)[OF iconf2'] by auto
then show ?thesis using CallRedsThrowParams[OF b1 b2] by fast
qed
next
case (CallNone e s⇩0 a s⇩1 ps vs h⇩2 l⇩2 sh⇩2 C fs M) show ?case
proof(cases "val_of e")
case None
then have iconf: "iconf (shp s⇩0) e" using CallNone.prems(1) by simp
have bconf: "P,shp s⇩0 ⊢⇩b (e,b) √" using CallNone.prems(2) None by simp
then have b1: "P ⊢ ⟨e,s⇩0,b⟩ →* ⟨addr a,s⇩1,False⟩" using CallNone.hyps(2)[OF iconf] by auto
have call: "P ⊢ ⟨e∙M(ps),s⇩0,b⟩ →* ⟨addr a∙M(ps),s⇩1,False⟩" by(rule CallRedsObj[OF b1])
then have iconf2': "iconfs (shp s⇩1) ps" using Red_preserves_iconf[OF wwf call] None CallNone by auto
have "P,shp s⇩1 ⊢⇩b (ps,False) √" by(simp add: bconfs_def)
then have b2: "P ⊢ ⟨ps,s⇩1,False⟩ [→]* ⟨map Val vs,(h⇩2, l⇩2, sh⇩2),False⟩"
using CallNone.hyps(4)[OF iconf2'] by auto
then show ?thesis using CallRedsNone[OF b1 b2 _ CallNone.hyps(6)] CallNone.hyps(5) by fastforce
next
case (Some a')
then obtain b1 where b1: "P ⊢ ⟨e,s⇩0,b⟩ →* ⟨addr a,s⇩1,b1⟩"
by (metis (no_types, lifting) CallNone.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
have fass: "P ⊢ ⟨e∙M(ps),s⇩0,b⟩ →* ⟨addr a∙M(ps),s⇩1,b1⟩" by(rule CallRedsObj[OF b1])
then have iconf2': "iconfs (shp s⇩1) ps" using Red_preserves_iconf[OF wwf fass] CallNone by auto
have bconf2: "P,shp s⇩0 ⊢⇩b (ps,b) √" using CallNone.prems Some by simp
then have "P,shp s⇩1 ⊢⇩b (ps,b1) √" using Red_preserves_bconf[OF wwf fass CallNone.prems] by simp
then have b2: "P ⊢ ⟨ps,s⇩1,b1⟩ [→]* ⟨map Val vs,(h⇩2, l⇩2, sh⇩2),False⟩"
using CallNone.hyps(4)[OF iconf2'] by auto
then show ?thesis using CallRedsNone[OF b1 b2 _ CallNone.hyps(6)] CallNone.hyps(5) by fastforce
qed
next
case (CallStatic e s⇩0 a s⇩1 ps vs h⇩2 l⇩2 sh⇩2 C fs M Ts T m D) show ?case
proof(cases "val_of e")
case None
then have iconf: "iconf (shp s⇩0) e" using CallStatic.prems(1) by simp
have bconf: "P,shp s⇩0 ⊢⇩b (e,b) √" using CallStatic.prems(2) None by simp
then have b1: "P ⊢ ⟨e,s⇩0,b⟩ →* ⟨addr a,s⇩1,False⟩" using CallStatic.hyps(2)[OF iconf] by auto
have call: "P ⊢ ⟨e∙M(ps),s⇩0,b⟩ →* ⟨addr a∙M(ps),s⇩1,False⟩" by(rule CallRedsObj[OF b1])
then have iconf2': "iconfs (shp s⇩1) ps" using Red_preserves_iconf[OF wwf call] None CallStatic by auto
have "P,shp s⇩1 ⊢⇩b (ps,False) √" by(simp add: bconfs_def)
then have b2: "P ⊢ ⟨ps,s⇩1,False⟩ [→]* ⟨map Val vs,(h⇩2, l⇩2, sh⇩2),False⟩"
using CallStatic.hyps(4)[OF iconf2'] by auto
then show ?thesis using CallRedsStatic[OF b1 b2 _ CallStatic.hyps(6)] CallStatic.hyps(5) by fastforce
next
case (Some a')
then obtain b1 where b1: "P ⊢ ⟨e,s⇩0,b⟩ →* ⟨addr a,s⇩1,b1⟩"
by (metis (no_types, lifting) CallStatic.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
have call: "P ⊢ ⟨e∙M(ps),s⇩0,b⟩ →* ⟨addr a∙M(ps),s⇩1,b1⟩" by(rule CallRedsObj[OF b1])
then have iconf2': "iconfs (shp s⇩1) ps" using Red_preserves_iconf[OF wwf call] CallStatic by auto
have bconf2: "P,shp s⇩0 ⊢⇩b (ps,b) √" using CallStatic.prems Some by simp
then have "P,shp s⇩1 ⊢⇩b (ps,b1) √" using Red_preserves_bconf[OF wwf call CallStatic.prems] by simp
then have b2: "P ⊢ ⟨ps,s⇩1,b1⟩ [→]* ⟨map Val vs,(h⇩2, l⇩2, sh⇩2),False⟩"
using CallStatic.hyps(4)[OF iconf2'] by auto
then show ?thesis using CallRedsStatic[OF b1 b2 _ CallStatic.hyps(6)] CallStatic.hyps(5) by fastforce
qed
next
case (Call e s⇩0 a s⇩1 ps vs h⇩2 l⇩2 sh⇩2 C fs M Ts T pns body D l⇩2' e' h⇩3 l⇩3 sh⇩3) show ?case
proof(cases "val_of e")
case None
then have iconf: "iconf (shp s⇩0) e" using Call.prems(1) by simp
have bconf: "P,shp s⇩0 ⊢⇩b (e,b) √" using Call.prems(2) None by simp
then have b1: "P ⊢ ⟨e,s⇩0,b⟩ →* ⟨addr a,s⇩1,False⟩" using Call.hyps(2)[OF iconf] by auto
have call: "P ⊢ ⟨e∙M(ps),s⇩0,b⟩ →* ⟨addr a∙M(ps),s⇩1,False⟩" by(rule CallRedsObj[OF b1])
then have iconf2: "iconfs (shp s⇩1) ps" using Red_preserves_iconf[OF wwf call] None Call by auto
have "P,shp s⇩1 ⊢⇩b (ps,False) √" by(simp add: bconfs_def)
then have b2: "P ⊢ ⟨ps,s⇩1,False⟩ [→]* ⟨map Val vs,(h⇩2, l⇩2, sh⇩2),False⟩"
using Call.hyps(4)[OF iconf2] by simp
have iconf3: "iconf (shp (h⇩2, l⇩2', sh⇩2)) body"
by(rule nsub_RI_iconf[OF sees_wwf_nsub_RI[OF wwf Call.hyps(6)]])
have "P,shp (h⇩2, l⇩2', sh⇩2) ⊢⇩b (body,False) √" by(simp add: bconf_def)
then have b3: "P ⊢ ⟨body,(h⇩2, l⇩2', sh⇩2),False⟩ →* ⟨e',(h⇩3, l⇩3, sh⇩3),False⟩"
using Call.hyps(10)[OF iconf3] by simp
show ?thesis by(rule CallRedsFinal[OF wwf b1 b2 Call.hyps(5-8) b3 eval_final[OF Call.hyps(9)]])
next
case (Some a')
then obtain b1 where b1: "P ⊢ ⟨e,s⇩0,b⟩ →* ⟨addr a,s⇩1,b1⟩"
by (metis (no_types, lifting) Call.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
have call: "P ⊢ ⟨e∙M(ps),s⇩0,b⟩ →* ⟨addr a∙M(ps),s⇩1,b1⟩" by(rule CallRedsObj[OF b1])
then have iconf2': "iconfs (shp s⇩1) ps" using Red_preserves_iconf[OF wwf call] Call by auto
have bconf2: "P,shp s⇩0 ⊢⇩b (ps,b) √" using Call.prems Some by simp
then have "P,shp s⇩1 ⊢⇩b (ps,b1) √" using Red_preserves_bconf[OF wwf call Call.prems] by simp
then have b2: "P ⊢ ⟨ps,s⇩1,b1⟩ [→]* ⟨map Val vs,(h⇩2, l⇩2, sh⇩2),False⟩"
using Call.hyps(4)[OF iconf2'] by auto
have iconf3: "iconf (shp (h⇩2, l⇩2', sh⇩2)) body"
by(rule nsub_RI_iconf[OF sees_wwf_nsub_RI[OF wwf Call.hyps(6)]])
have "P,shp (h⇩2, l⇩2', sh⇩2) ⊢⇩b (body,False) √" by(simp add: bconf_def)
then have b3: "P ⊢ ⟨body,(h⇩2, l⇩2', sh⇩2),False⟩ →* ⟨e',(h⇩3, l⇩3, sh⇩3),False⟩"
using Call.hyps(10)[OF iconf3] by simp
show ?thesis by(rule CallRedsFinal[OF wwf b1 b2 Call.hyps(5-8) b3 eval_final[OF Call.hyps(9)]])
qed
next
case (SCallParamsThrow es s⇩0 vs ex es' s⇩2 C M) show ?case
proof(cases "map_vals_of es")
case None
then have iconf: "iconfs (shp s⇩0) es" using SCallParamsThrow.prems(1) by simp
have bconf: "P,shp s⇩0 ⊢⇩b (es,b) √" using SCallParamsThrow.prems(2) None by simp
then have b1: "P ⊢ ⟨es,s⇩0,b⟩ [→]* ⟨map Val vs @ throw ex # es',s⇩2,False⟩"
using SCallParamsThrow.hyps(2)[OF iconf] by simp
show ?thesis using SCallRedsThrowParams[OF b1] by simp
next
case (Some vs')
then have "es = map Val vs'" by(rule map_vals_of_spec)
then show ?thesis using evals_finals_same[OF _ SCallParamsThrow.hyps(1)] map_Val_nthrow_neq
by auto
qed
next
case (SCallNone ps s⇩0 vs s⇩2 C M) show ?case
proof(cases "map_vals_of ps")
case None
then have iconf: "iconfs (shp s⇩0) ps" using SCallNone.prems(1) by simp
have bconf: "P,shp s⇩0 ⊢⇩b (ps,b) √" using SCallNone.prems(2) None by simp
then have b1: "P ⊢ ⟨ps,s⇩0,b⟩ [→]* ⟨map Val vs,s⇩2,False⟩" using SCallNone.hyps(2)[OF iconf] by auto
then show ?thesis using SCallRedsNone[OF b1 SCallNone.hyps(3)] SCallNone.hyps(1) by simp
next
case (Some vs')
then have ps: "ps = map Val vs'" by(rule map_vals_of_spec)
then have s⇩0: "s⇩0 = s⇩2" using SCallNone.hyps(1) evals_finals_same by blast
then show ?thesis using RedSCallNone[OF SCallNone.hyps(3)] ps by(cases s⇩2, auto)
qed
next
case (SCallNonStatic ps s⇩0 vs s⇩2 C M Ts T m D) show ?case
proof(cases "map_vals_of ps")
case None
then have iconf: "iconfs (shp s⇩0) ps" using SCallNonStatic.prems(1) by simp
have bconf: "P,shp s⇩0 ⊢⇩b (ps,b) √" using SCallNonStatic.prems(2) None by simp
then have b1: "P ⊢ ⟨ps,s⇩0,b⟩ [→]* ⟨map Val vs,s⇩2,False⟩" using SCallNonStatic.hyps(2)[OF iconf] by auto
then show ?thesis using SCallRedsNonStatic[OF b1 SCallNonStatic.hyps(3)] SCallNonStatic.hyps(1) by simp
next
case (Some vs')
then have ps: "ps = map Val vs'" by(rule map_vals_of_spec)
then have s⇩0: "s⇩0 = s⇩2" using SCallNonStatic.hyps(1) evals_finals_same by blast
then show ?thesis using RedSCallNonStatic[OF SCallNonStatic.hyps(3)] ps by(cases s⇩2, auto)
qed
next
case (SCallInitThrow ps s⇩0 vs h⇩1 l⇩1 sh⇩1 C M Ts T pns body D a s') show ?case
proof(cases "map_vals_of ps")
case None
then have iconf: "iconfs (shp s⇩0) ps" using SCallInitThrow.prems(1) by simp
have bconf: "P,shp s⇩0 ⊢⇩b (ps,b) √" using SCallInitThrow.prems(2) None by simp
then have b1: "P ⊢ ⟨ps,s⇩0,b⟩ [→]* ⟨map Val vs,(h⇩1, l⇩1, sh⇩1),False⟩"
using SCallInitThrow.hyps(2)[OF iconf] by auto
have bconf2: "P,shp (h⇩1, l⇩1, sh⇩1) ⊢⇩b (INIT D ([D],False) ← unit,False) √" by(simp add: bconf_def)
then have b2: "P ⊢ ⟨INIT D ([D],False) ← unit,(h⇩1, l⇩1, sh⇩1),False⟩ →* ⟨throw a,s',False⟩"
using SCallInitThrow.hyps(7) by auto
then show ?thesis using SCallInitThrowReds[OF wwf b1 SCallInitThrow.hyps(3-5)]
by(cases s', auto)
next
case (Some vs')
have ps: "ps = map Val vs'" by(rule map_vals_of_spec[OF Some])
then have vs: "vs = vs' ∧ s⇩0 = (h⇩1, l⇩1, sh⇩1)"
using evals_finals_same[OF _ SCallInitThrow.hyps(1)] map_Val_eq by auto
show ?thesis
proof(cases b)
case True
obtain sfs where shC: "sh⇩1 D = ⌊(sfs, Processing)⌋"
using SCallInitThrow.hyps(3,4) SCallInitThrow.prems(2) True Some vs
by(auto simp: bconf_def initPD_def dest: sees_method_fun)
then show ?thesis using init_ProcessingE[OF _ SCallInitThrow.hyps(6)] by blast
next
case False
then have b1: "P ⊢ ⟨ps,s⇩0,b⟩ [→]* ⟨map Val vs,(h⇩1, l⇩1, sh⇩1),False⟩" using ps vs by simp
have bconf2: "P,shp (h⇩1, l⇩1, sh⇩1) ⊢⇩b (INIT D ([D],False) ← unit,False) √" by(simp add: bconf_def)
then have b2: "P ⊢ ⟨INIT D ([D],False) ← unit,(h⇩1, l⇩1, sh⇩1),False⟩ →* ⟨throw a,s',False⟩"
using SCallInitThrow.hyps(7) by auto
then show ?thesis using SCallInitThrowReds[OF wwf b1 SCallInitThrow.hyps(3-5)] by(cases s', auto)
qed
qed
next
case (SCallInit ps s⇩0 vs h⇩1 l⇩1 sh⇩1 C M Ts T pns body D v' h⇩2 l⇩2 sh⇩2 l⇩2' e' h⇩3 l⇩3 sh⇩3) show ?case
proof(cases "map_vals_of ps")
case None
then have iconf: "iconfs (shp s⇩0) ps" using SCallInit.prems(1) by simp
have bconf: "P,shp s⇩0 ⊢⇩b (ps,b) √" using SCallInit.prems(2) None by simp
then have b1: "P ⊢ ⟨ps,s⇩0,b⟩ [→]* ⟨map Val vs,(h⇩1, l⇩1, sh⇩1),False⟩"
using SCallInit.hyps(2)[OF iconf] by auto
have bconf2: "P,shp (h⇩1, l⇩1, sh⇩1) ⊢⇩b (INIT D ([D],False) ← unit,False) √" by(simp add: bconf_def)
then have b2: "P ⊢ ⟨INIT D ([D],False) ← unit,(h⇩1, l⇩1, sh⇩1),False⟩ →* ⟨Val v',(h⇩2, l⇩2, sh⇩2),False⟩"
using SCallInit.hyps(7) by auto
have iconf3: "iconf (shp (h⇩2, l⇩2', sh⇩2)) body"
by(rule nsub_RI_iconf[OF sees_wwf_nsub_RI[OF wwf SCallInit.hyps(3)]])
have "P,shp (h⇩2, l⇩2', sh⇩2) ⊢⇩b (body,False) √" by(simp add: bconf_def)
then have b3: "P ⊢ ⟨body,(h⇩2, l⇩2', sh⇩2),False⟩ →* ⟨e',(h⇩3, l⇩3, sh⇩3),False⟩"
using SCallInit.hyps(11)[OF iconf3] by simp
show ?thesis by(rule SCallInitReds[OF wwf b1 SCallInit.hyps(3-5) b2 SCallInit.hyps(8-9)
b3 eval_final[OF SCallInit.hyps(10)]])
next
case (Some vs')
then have ps: "ps = map Val vs'" by(rule map_vals_of_spec)
then have vs: "vs = vs' ∧ s⇩0 = (h⇩1, l⇩1, sh⇩1)"
using evals_finals_same[OF _ SCallInit.hyps(1)] map_Val_eq by auto
show ?thesis
proof(cases b)
case True
then have b1: "P ⊢ ⟨ps,s⇩0,b⟩ [→]* ⟨map Val vs,(h⇩1, l⇩1, sh⇩1),b⟩" using ps vs by simp
obtain sfs where shC: "sh⇩1 D = ⌊(sfs, Processing)⌋"
using SCallInit.hyps(3,4) SCallInit.prems(2) True Some vs
by(auto simp: bconf_def initPD_def dest: sees_method_fun)
then have s': "(h⇩1, l⇩1, sh⇩1) = (h⇩2, l⇩2, sh⇩2)" using init_ProcessingE[OF _ SCallInit.hyps(6)] by simp
have iconf3: "iconf (shp (h⇩2, l⇩2', sh⇩2)) body"
by(rule nsub_RI_iconf[OF sees_wwf_nsub_RI[OF wwf SCallInit.hyps(3)]])
have "P,shp (h⇩2, l⇩2', sh⇩2) ⊢⇩b (body,False) √" by(simp add: bconf_def)
then have b3: "P ⊢ ⟨body,(h⇩2, l⇩2', sh⇩2),False⟩ →* ⟨e',(h⇩3, l⇩3, sh⇩3),False⟩"
using SCallInit.hyps(11)[OF iconf3] by simp
then have b3': "P ⊢ ⟨body,(h⇩1, l⇩2', sh⇩1),False⟩ →* ⟨e',(h⇩3, l⇩3, sh⇩3),False⟩"
using s' by simp
then show ?thesis using SCallInitProcessingReds[OF wwf b1 SCallInit.hyps(3) shC
SCallInit.hyps(8-9) b3' eval_final[OF SCallInit.hyps(10)]] s' by simp
next
case False
then have b1: "P ⊢ ⟨ps,s⇩0,b⟩ [→]* ⟨map Val vs,(h⇩1, l⇩1, sh⇩1),False⟩" using ps vs by simp
have bconf2: "P,shp (h⇩1, l⇩1, sh⇩1) ⊢⇩b (INIT D ([D],False) ← unit,False) √" by(simp add: bconf_def)
then have b2: "P ⊢ ⟨INIT D ([D],False) ← unit,(h⇩1, l⇩1, sh⇩1),False⟩ →* ⟨Val v',(h⇩2, l⇩2, sh⇩2),False⟩"
using SCallInit.hyps(7) by auto
have iconf3: "iconf (shp (h⇩2, l⇩2', sh⇩2)) body"
by(rule nsub_RI_iconf[OF sees_wwf_nsub_RI[OF wwf SCallInit.hyps(3)]])
have "P,shp (h⇩2, l⇩2', sh⇩2) ⊢⇩b (body,False) √" by(simp add: bconf_def)
then have b3: "P ⊢ ⟨body,(h⇩2, l⇩2', sh⇩2),False⟩ →* ⟨e',(h⇩3, l⇩3, sh⇩3),False⟩"
using SCallInit.hyps(11)[OF iconf3] by simp
show ?thesis by(rule SCallInitReds[OF wwf b1 SCallInit.hyps(3-5) b2 SCallInit.hyps(8-9)
b3 eval_final[OF SCallInit.hyps(10)]])
qed
qed
next
case (SCall ps s⇩0 vs h⇩2 l⇩2 sh⇩2 C M Ts T pns body D sfs l⇩2' e' h⇩3 l⇩3 sh⇩3) show ?case
proof(cases "map_vals_of ps")
case None
then have iconf: "iconfs (shp s⇩0) ps" using SCall.prems(1) by simp
have bconf: "P,shp s⇩0 ⊢⇩b (ps,b) √" using SCall.prems(2) None by simp
then have b1: "P ⊢ ⟨ps,s⇩0,b⟩ [→]* ⟨map Val vs,(h⇩2, l⇩2, sh⇩2),False⟩"
using SCall.hyps(2)[OF iconf] by auto
have iconf3: "iconf (shp (h⇩2, l⇩2', sh⇩2)) body"
by(rule nsub_RI_iconf[OF sees_wwf_nsub_RI[OF wwf SCall.hyps(3)]])
have "P,shp (h⇩2, l⇩2', sh⇩2) ⊢⇩b (body,False) √" by(simp add: bconf_def)
then have b2: "P ⊢ ⟨body,(h⇩2, l⇩2', sh⇩2),False⟩ →* ⟨e',(h⇩3, l⇩3, sh⇩3),False⟩"
using SCall.hyps(8)[OF iconf3] by simp
show ?thesis by(rule SCallRedsFinal[OF wwf b1 SCall.hyps(3-6) b2 eval_final[OF SCall.hyps(7)]])
next
case (Some vs')
then have ps: "ps = map Val vs'" by(rule map_vals_of_spec)
then have vs: "vs = vs' ∧ s⇩0 = (h⇩2, l⇩2, sh⇩2)"
using evals_finals_same[OF _ SCall.hyps(1)] map_Val_eq by auto
then have b1: "P ⊢ ⟨ps,s⇩0,b⟩ [→]* ⟨map Val vs,(h⇩2, l⇩2, sh⇩2),b⟩" using ps by simp
have iconf3: "iconf (shp (h⇩2, l⇩2', sh⇩2)) body"
by(rule nsub_RI_iconf[OF sees_wwf_nsub_RI[OF wwf SCall.hyps(3)]])
have "P,shp (h⇩2, l⇩2', sh⇩2) ⊢⇩b (body,False) √" by(simp add: bconf_def)
then have b2: "P ⊢ ⟨body,(h⇩2, l⇩2', sh⇩2),False⟩ →* ⟨e',(h⇩3, l⇩3, sh⇩3),False⟩"
using SCall.hyps(8)[OF iconf3] by simp
show ?thesis by(rule SCallRedsFinal[OF wwf b1 SCall.hyps(3-6) b2 eval_final[OF SCall.hyps(7)]])
qed
next
case (Block e⇩0 h⇩0 l⇩0 V sh⇩0 e⇩1 h⇩1 l⇩1 sh⇩1 T)
have iconf: "iconf (shp (h⇩0, l⇩0(V := None), sh⇩0)) e⇩0"
using Block.prems(1) by (auto simp: assigned_def)
have bconf: "P,shp (h⇩0, l⇩0(V := None), sh⇩0) ⊢⇩b (e⇩0,b) √" using Block.prems(2)
by(auto simp: bconf_def)
then have b': "P ⊢ ⟨e⇩0,(h⇩0, l⇩0(V := None), sh⇩0),b⟩ →* ⟨e⇩1,(h⇩1, l⇩1, sh⇩1),False⟩"
using Block.hyps(2)[OF iconf] by auto
have fin: "final e⇩1" using Block by(auto dest: eval_final)
thus ?case using BlockRedsFinal[OF b' fin] by simp
next
case (Seq e⇩0 s⇩0 v s⇩1 e⇩1 e⇩2 s⇩2)
then have iconf: "iconf (shp s⇩0) e⇩0" using Seq.prems(1)
by(auto dest: val_of_spec lass_val_of_spec)
have b1: "∃b1. P ⊢ ⟨e⇩0,s⇩0,b⟩ →* ⟨Val v,s⇩1,b1⟩"
proof(cases "val_of e⇩0")
case None show ?thesis
proof(cases "lass_val_of e⇩0")
case lNone:None
then have bconf: "P,shp s⇩0 ⊢⇩b (e⇩0,b) √" using Seq.prems(2) None by simp
then have "P ⊢ ⟨e⇩0,s⇩0,b⟩ →* ⟨Val v,s⇩1,False⟩" using iconf Seq.hyps(2) by auto
then show ?thesis by fast
next
case (Some p)
obtain V' v' where p: "p = (V',v')" and e⇩0: "e⇩0 = V':=Val v'"
using lass_val_of_spec[OF Some] by(cases p, auto)
obtain h l sh h' l' sh' where s⇩0: "s⇩0 = (h,l,sh)" and s⇩1: "s⇩1 = (h',l',sh')" by(cases s⇩0, cases s⇩1)
then have eval: "P ⊢ ⟨e⇩0,(h,l,sh)⟩ ⇒ ⟨Val v,(h',l',sh')⟩" using Seq.hyps(1) by simp
then have s⇩1': "Val v = unit ∧ h' = h ∧ l' = l(V' ↦ v') ∧ sh' = sh"
using lass_val_of_eval[OF Some eval] p e⇩0 by simp
then have "P ⊢ ⟨e⇩0,s⇩0,b⟩ → ⟨Val v,s⇩1,b⟩" using e⇩0 s⇩0 s⇩1 by(auto intro: RedLAss)
then show ?thesis by auto
qed
next
case (Some a)
then have "e⇩0 = Val v" and "s⇩0 = s⇩1" using Seq.hyps(1) eval_cases(3) val_of_spec by blast+
then show ?thesis using Seq by auto
qed
then obtain b1 where b1': "P ⊢ ⟨e⇩0,s⇩0,b⟩ →* ⟨Val v,s⇩1,b1⟩" by clarsimp
have seq: "P ⊢ ⟨e⇩0;;e⇩1,s⇩0,b⟩ →* ⟨Val v;;e⇩1,s⇩1,b1⟩" by(rule SeqReds[OF b1'])
then have iconf2: "iconf (shp s⇩1) e⇩1" using Red_preserves_iconf[OF wwf seq] Seq nsub_RI_iconf
by auto
have "P,shp s⇩1 ⊢⇩b (Val v;; e⇩1,b1) √" by(rule Red_preserves_bconf[OF wwf seq Seq.prems])
then have bconf2: "P,shp s⇩1 ⊢⇩b (e⇩1,b1) √" by simp
have b2: "P ⊢ ⟨e⇩1,s⇩1,b1⟩ →* ⟨e⇩2,s⇩2,False⟩" by(rule Seq.hyps(4)[OF iconf2 bconf2])
then show ?case using SeqReds2[OF b1' b2] by fast
next
case (SeqThrow e⇩0 s⇩0 a s⇩1 e⇩1 b)
have notVal: "val_of e⇩0 = None" "lass_val_of e⇩0 = None"
using SeqThrow.hyps(1) eval_throw_nonVal eval_throw_nonLAss by auto
thus ?case using SeqThrow notVal by(auto dest!:eval_final dest: SeqRedsThrow)
next
case (CondT e s⇩0 s⇩1 e⇩1 e' s⇩2 e⇩2)
then have iconf: "iconf (shp s⇩0) e" using CondT.prems(1) by auto
have bconf: "P,shp s⇩0 ⊢⇩b (e,b) √" using CondT.prems(2) by auto
then have b1: "P ⊢ ⟨e,s⇩0,b⟩ →* ⟨true,s⇩1,False⟩" using iconf CondT.hyps(2) by auto
have cond: "P ⊢ ⟨if (e) e⇩1 else e⇩2,s⇩0,b⟩ →* ⟨if (true) e⇩1 else e⇩2,s⇩1,False⟩" by(rule CondReds[OF b1])
then have iconf2': "iconf (shp s⇩1) e⇩1" using Red_preserves_iconf[OF wwf cond] CondT nsub_RI_iconf
by auto
have "P,shp s⇩1 ⊢⇩b (e⇩1,False) √" by(simp add: bconf_def)
then have b2: "P ⊢ ⟨e⇩1,s⇩1,False⟩ →* ⟨e',s⇩2,False⟩" using CondT.hyps(4)[OF iconf2'] by auto
then show ?case using CondReds2T[OF b1 b2] by fast
next
case (CondF e s⇩0 s⇩1 e⇩2 e' s⇩2 e⇩1)
then have iconf: "iconf (shp s⇩0) e" using CondF.prems(1) by auto
have bconf: "P,shp s⇩0 ⊢⇩b (e,b) √" using CondF.prems(2) by auto
then have b1: "P ⊢ ⟨e,s⇩0,b⟩ →* ⟨false,s⇩1,False⟩" using iconf CondF.hyps(2) by auto
have cond: "P ⊢ ⟨if (e) e⇩1 else e⇩2,s⇩0,b⟩ →* ⟨if (false) e⇩1 else e⇩2,s⇩1,False⟩" by(rule CondReds[OF b1])
then have iconf2': "iconf (shp s⇩1) e⇩2" using Red_preserves_iconf[OF wwf cond] CondF nsub_RI_iconf
by auto
have "P,shp s⇩1 ⊢⇩b (e⇩2,False) √" by(simp add: bconf_def)
then have b2: "P ⊢ ⟨e⇩2,s⇩1,False⟩ →* ⟨e',s⇩2,False⟩" using CondF.hyps(4)[OF iconf2'] by auto
then show ?case using CondReds2F[OF b1 b2] by fast
next
case CondThrow thus ?case by(auto dest!:eval_final dest:CondRedsThrow)
next
case (WhileF e s⇩0 s⇩1 c)
then have iconf: "iconf (shp s⇩0) e" using nsub_RI_iconf by auto
then have bconf: "P,shp s⇩0 ⊢⇩b (e,b) √" using WhileF.prems(2) by(simp add: bconf_def)
then have b': "P ⊢ ⟨e,s⇩0,b⟩ →* ⟨false,s⇩1,False⟩" using WhileF.hyps(2) iconf by auto
thus ?case using WhileFReds[OF b'] by fast
next
case (WhileT e s⇩0 s⇩1 c v⇩1 s⇩2 e⇩3 s⇩3)
then have iconf: "iconf (shp s⇩0) e" using nsub_RI_iconf by auto
then have bconf: "P,shp s⇩0 ⊢⇩b (e,b) √" using WhileT.prems(2) by(simp add: bconf_def)
then have b1: "P ⊢ ⟨e,s⇩0,b⟩ →* ⟨true,s⇩1,False⟩" using WhileT.hyps(2) iconf by auto
have iconf2: "iconf (shp s⇩1) c" using WhileT.prems(1) nsub_RI_iconf by auto
have bconf2: "P,shp s⇩1 ⊢⇩b (c,False) √" by(simp add: bconf_def)
then have b2: "P ⊢ ⟨c,s⇩1,False⟩ →* ⟨Val v⇩1,s⇩2,False⟩" using WhileT.hyps(4) iconf2 by auto
have iconf3: "iconf (shp s⇩2) (while (e) c)" using WhileT.prems(1) by auto
have "P,shp s⇩2 ⊢⇩b (while (e) c,False) √" by(simp add: bconf_def)
then have b3: "P ⊢ ⟨while (e) c,s⇩2,False⟩ →* ⟨e⇩3,s⇩3,False⟩" using WhileT.hyps(6) iconf3 by auto
show ?case using WhileTReds[OF b1 b2 b3] by fast
next
case WhileCondThrow thus ?case
by (metis (no_types, lifting) WhileRedsThrow iconf.simps(16) bconf_While bconf_def nsub_RI_iconf)
next
case (WhileBodyThrow e s⇩0 s⇩1 c e' s⇩2)
then have iconf: "iconf (shp s⇩0) e" using nsub_RI_iconf by auto
then have bconf: "P,shp s⇩0 ⊢⇩b (e,b) √" using WhileBodyThrow.prems(2) by(simp add: bconf_def)
then have b1: "P ⊢ ⟨e,s⇩0,b⟩ →* ⟨true,s⇩1,False⟩" using WhileBodyThrow.hyps(2) iconf by auto
have iconf2: "iconf (shp s⇩1) c" using WhileBodyThrow.prems(1) nsub_RI_iconf by auto
have bconf2: "P,shp s⇩1 ⊢⇩b (c,False) √" by(simp add: bconf_def)
then have b2: "P ⊢ ⟨c,s⇩1,False⟩ →* ⟨throw e',s⇩2,False⟩" using WhileBodyThrow.hyps(4) iconf2 by auto
show ?case using WhileTRedsThrow[OF b1 b2] by fast
next
case Throw thus ?case by (meson ThrowReds iconf.simps(17) bconf_Throw)
next
case ThrowNull thus ?case by (meson ThrowRedsNull iconf.simps(17) bconf_Throw)
next
case ThrowThrow thus ?case by (meson ThrowRedsThrow iconf.simps(17) bconf_Throw)
next
case Try thus ?case by (meson TryRedsVal iconf.simps(18) bconf_Try)
next
case (TryCatch e⇩1 s⇩0 a h⇩1 l⇩1 sh⇩1 D fs C e⇩2 V e⇩2' h⇩2 l⇩2 sh⇩2)
then have b1: "P ⊢ ⟨e⇩1,s⇩0,b⟩ →* ⟨Throw a,(h⇩1, l⇩1, sh⇩1),False⟩" by auto
have Try: "P ⊢ ⟨try e⇩1 catch(C V) e⇩2,s⇩0,b⟩ →* ⟨try (Throw a) catch(C V) e⇩2,(h⇩1, l⇩1, sh⇩1),False⟩"
by(rule TryReds[OF b1])
have iconf: "iconf sh⇩1 e⇩2" using Red_preserves_iconf[OF wwf Try] TryCatch nsub_RI_iconf
by auto
have bconf: "P,shp (h⇩1, l⇩1(V ↦ Addr a), sh⇩1) ⊢⇩b (e⇩2,False) √" by(simp add: bconf_def)
then have b2: "P ⊢ ⟨e⇩2,(h⇩1, l⇩1(V ↦ Addr a), sh⇩1),False⟩ →* ⟨e⇩2',(h⇩2, l⇩2, sh⇩2),False⟩"
using TryCatch.hyps(6) iconf by auto
thus ?case using TryCatchRedsFinal[OF b1] TryCatch.hyps(3-5) by (meson eval_final)
next
case TryThrow thus ?case by (meson TryRedsFail iconf.simps(18) bconf_Try)
next
case Nil thus ?case by(auto simp: bconfs_def)
next
case (Cons e s⇩0 v s⇩1 es es' s⇩2) show ?case
proof(cases "val_of e")
case None
then have iconf: "iconf (shp s⇩0) e" using Cons.prems(1) by simp
have bconf: "P,shp s⇩0 ⊢⇩b (e,b) √" using Cons.prems(2) None by simp
then have b1: "P ⊢ ⟨e,s⇩0,b⟩ →* ⟨Val v,s⇩1,False⟩" using Cons.hyps(2) iconf by auto
have cons: "P ⊢ ⟨e # es,s⇩0,b⟩ [→]* ⟨Val v # es,s⇩1,False⟩" by(rule ListReds1[OF b1])
then have iconf2': "iconfs (shp s⇩1) es" using Reds_preserves_iconf[OF wwf cons] None Cons by auto
have "P,shp s⇩1 ⊢⇩b (es,False) √" by(simp add: bconfs_def)
then have b2: "P ⊢ ⟨es,s⇩1,False⟩ [→]* ⟨es',s⇩2,False⟩" using Cons.hyps(4)[OF iconf2'] by auto
show ?thesis using ListRedsVal[OF b1 b2] by auto
next
case (Some a)
then obtain b1 where b1: "P ⊢ ⟨e,s⇩0,b⟩ →* ⟨Val v,s⇩1,b1⟩"
by (metis (no_types, lifting) Cons.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
have cons: "P ⊢ ⟨e # es,s⇩0,b⟩ [→]* ⟨Val v # es,s⇩1,b1⟩" by(rule ListReds1[OF b1])
then have iconf2': "iconfs (shp s⇩1) es" using Reds_preserves_iconf[OF wwf cons] Cons by auto
have bconf2: "P,shp s⇩0 ⊢⇩b (es,b) √" using Cons.prems Some by simp
then have "P,shp s⇩1 ⊢⇩b (es,b1) √" using Reds_preserves_bconf[OF wwf cons Cons.prems] by simp
then have b2: "P ⊢ ⟨es,s⇩1,b1⟩ [→]* ⟨es',s⇩2,False⟩" using Cons.hyps(4)[OF iconf2'] by auto
show ?thesis using ListRedsVal[OF b1 b2] by auto
qed
next
case (ConsThrow e s⇩0 e' s⇩1 es) show ?case
proof(cases "val_of e")
case None
then have iconf: "iconf (shp s⇩0) e" using ConsThrow.prems(1) by simp
have bconf: "P,shp s⇩0 ⊢⇩b (e,b) √" using ConsThrow.prems(2) None by simp
then have b1: "P ⊢ ⟨e,s⇩0,b⟩ →* ⟨throw e',s⇩1,False⟩" using ConsThrow.hyps(2) iconf by auto
have cons: "P ⊢ ⟨e # es,s⇩0,b⟩ [→]* ⟨throw e' # es,s⇩1,False⟩" by(rule ListReds1[OF b1])
then show ?thesis by fast
next
case (Some a)
then show ?thesis using eval_final_same[OF ConsThrow.hyps(1)] val_of_spec[OF Some] by auto
qed
next
case (InitFinal e s e' s' C b')
then have "¬sub_RI e" by simp
then show ?case using InitFinal RedInit[of e C b' s b P]
by (meson converse_rtrancl_into_rtrancl nsub_RI_iconf red_preserves_bconf RedInit)
next
case (InitNone sh C C' Cs e h l e' s')
then have init: "P ⊢ ⟨INIT C' (C # Cs,False) ← e,(h, l, sh(C ↦ (sblank P C, Prepared))),b⟩ →* ⟨e',s',False⟩"
by(simp add: bconf_def)
show ?case by(rule InitNoneReds[OF InitNone.hyps(1) init])
next
case (InitDone sh C sfs C' Cs e h l e' s')
then have "iconf (shp (h, l, sh)) (INIT C' (Cs,True) ← e)" using InitDone.hyps(1)
proof(cases Cs)
case Nil
then have "C = C'" "¬sub_RI e" using InitDone.prems(1) by simp+
then show ?thesis using Nil InitDone.hyps(1) by(simp add: initPD_def)
qed(auto)
then have init: "P ⊢ ⟨INIT C' (Cs,True) ← e,(h, l, sh),b⟩ →* ⟨e',s',False⟩"
using InitDone by(simp add: bconf_def)
show ?case by(rule InitDoneReds[OF InitDone.hyps(1) init])
next
case (InitProcessing sh C sfs C' Cs e h l e' s')
then have "iconf (shp (h, l, sh)) (INIT C' (Cs,True) ← e)" using InitProcessing.hyps(1)
proof(cases Cs)
case Nil
then have "C = C'" "¬sub_RI e" using InitProcessing.prems(1) by simp+
then show ?thesis using Nil InitProcessing.hyps(1) by(simp add: initPD_def)
qed(auto)
then have init: "P ⊢ ⟨INIT C' (Cs,True) ← e,(h, l, sh),b⟩ →* ⟨e',s',False⟩"
using InitProcessing by(simp add: bconf_def)
show ?case by(rule InitProcessingReds[OF InitProcessing.hyps(1) init])
next
case InitError thus ?case by(fastforce intro: InitErrorReds simp: bconf_def)
next
case InitObject thus ?case by(fastforce intro: InitObjectReds simp: bconf_def)
next
case InitNonObject thus ?case by(fastforce intro: InitNonObjectReds simp: bconf_def)
next
case InitRInit thus ?case by(fastforce intro: RedsInitRInit simp: bconf_def)
next
case (RInit e s v h' l' sh' C sfs i sh'' C' Cs e' e⇩1 s⇩1)
then have iconf2: "iconf (shp (h', l', sh'')) (INIT C' (Cs,True) ← e')"
by(auto simp: initPD_def fun_upd_same list_nonempty_induct)
show ?case
proof(cases "val_of e")
case None
then have iconf: "iconf (shp s) e" using RInit.prems(1) by simp
have bconf: "P,shp s ⊢⇩b (e,b) √" using RInit.prems(2) None by simp
then have b1: "P ⊢ ⟨e,s,b⟩ →* ⟨Val v,(h',l',sh'),False⟩" using RInit.hyps(2)[OF iconf] by auto
have "P,shp (h', l', sh'') ⊢⇩b (INIT C' (Cs,True) ← e',False) √" by(simp add: bconf_def)
then have b2: "P ⊢ ⟨INIT C' (Cs,True) ← e',(h',l',sh''),False⟩ →* ⟨e⇩1,s⇩1,False⟩"
using RInit.hyps(7)[OF iconf2] by auto
then show ?thesis using RedsRInit[OF b1 RInit.hyps(3-5) b2] by fast
next
case (Some a')
then obtain b1 where b1: "P ⊢ ⟨e,s,b⟩ →* ⟨Val v,(h',l',sh'),b1⟩"
by (metis (no_types, lifting) RInit.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
have fin: "final e" by(simp add: val_of_spec[OF Some])
have "¬b" using RInit.prems(2) Some by(simp add: bconf_def)
then have nb1: "¬b1" using reds_final_same[OF b1 fin] by simp
have "P,shp (h', l', sh'') ⊢⇩b (INIT C' (Cs,True) ← e',b1) √" using nb1
by(simp add: bconf_def)
then have b2: "P ⊢ ⟨INIT C' (Cs,True) ← e',(h', l', sh''),b1⟩ →* ⟨e⇩1,s⇩1,False⟩"
using RInit.hyps(7)[OF iconf2] by auto
then show ?thesis using RedsRInit[OF b1 RInit.hyps(3-5) b2] by fast
qed
next
case (RInitInitFail e s a h' l' sh' C sfs i sh'' D Cs e' e⇩1 s⇩1)
have fin: "final (throw a)" using eval_final[OF RInitInitFail.hyps(1)] by simp
then obtain a' where a': "throw a = Throw a'" by auto
have iconf2: "iconf (shp (h', l', sh'')) (RI (D,Throw a') ; Cs ← e')"
using RInitInitFail.prems(1) by auto
show ?case
proof(cases "val_of e")
case None
then have iconf: "iconf (shp s) e" using RInitInitFail.prems(1) by simp
have bconf: "P,shp s ⊢⇩b (e,b) √" using RInitInitFail.prems(2) None by simp
then have b1: "P ⊢ ⟨e,s,b⟩ →* ⟨Throw a',(h',l',sh'),False⟩"
using RInitInitFail.hyps(2)[OF iconf] a' by auto
have "P,shp (h', l', sh'') ⊢⇩b (RI (D,Throw a') ; Cs ← e',False) √" by(simp add: bconf_def)
then have b2: "P ⊢ ⟨RI (D,Throw a') ; Cs ← e',(h',l',sh''),False⟩ →* ⟨e⇩1,s⇩1,False⟩"
using RInitInitFail.hyps(6) iconf2 a' by auto
show ?thesis using RInitInitThrowReds[OF b1 RInitInitFail.hyps(3-4) b2] by fast
next
case (Some a1)
then obtain b1 where b1: "P ⊢ ⟨e,s,b⟩ →* ⟨Throw a',(h',l',sh'),b1⟩" using a'
by (metis (no_types, lifting) RInitInitFail.hyps(1) eval_cases(3) rtrancl.rtrancl_refl val_of_spec)
have fin: "final e" by(simp add: val_of_spec[OF Some])
have "¬b" using RInitInitFail.prems(2) Some by(simp add: bconf_def)
then have nb1: "¬b1" using reds_final_same[OF b1 fin] by simp
have "P,shp (h', l', sh'') ⊢⇩b (RI (D,Throw a') ; Cs ← e',b1) √" using nb1
by(simp add: bconf_def)
then have b2: "P ⊢ ⟨RI (D,Throw a') ; Cs ← e',(h', l', sh''),b1⟩ →* ⟨e⇩1,s⇩1,False⟩"
using RInitInitFail.hyps(6) iconf2 a' by auto
show ?thesis using RInitInitThrowReds[OF b1 RInitInitFail.hyps(3-4) b2] by fast
qed
next
case (RInitFailFinal e s a h' l' sh' C sfs i sh'' e')
have fin: "final (throw a)" using eval_final[OF RInitFailFinal.hyps(1)] by simp
then obtain a' where a': "throw a = Throw a'" by auto
show ?case
proof(cases "val_of e")
case None
then have iconf: "iconf (shp s) e" using RInitFailFinal.prems(1) by simp
have bconf: "P,shp s ⊢⇩b (e,b) √" using RInitFailFinal.prems(2) None by simp
then have b1: "P ⊢ ⟨e,s,b⟩ →* ⟨Throw a',(h',l',sh'),False⟩"
using RInitFailFinal.hyps(2)[OF iconf] a' by auto
show ?thesis using RInitThrowReds[OF b1 RInitFailFinal.hyps(3-4)] a' by fast
next
case (Some a1)
then show ?thesis using eval_final_same[OF RInitFailFinal.hyps(1)] val_of_spec[OF Some] by auto
qed
qed
subsection‹Big steps simulates small step›
text‹ This direction was carried out by Norbert Schirmer and Daniel
Wasserrab (and modified to include statics and DCI by Susannah Mansky). ›
text ‹ The big step equivalent of @{text RedWhile}: ›
lemma unfold_while:
"P ⊢ ⟨while(b) c,s⟩ ⇒ ⟨e',s'⟩ = P ⊢ ⟨if(b) (c;;while(b) c) else (unit),s⟩ ⇒ ⟨e',s'⟩"
proof
assume "P ⊢ ⟨while (b) c,s⟩ ⇒ ⟨e',s'⟩"
thus "P ⊢ ⟨if (b) (c;; while (b) c) else unit,s⟩ ⇒ ⟨e',s'⟩"
by cases (fastforce intro: eval_evals.intros)+
next
assume "P ⊢ ⟨if (b) (c;; while (b) c) else unit,s⟩ ⇒ ⟨e',s'⟩"
thus "P ⊢ ⟨while (b) c,s⟩ ⇒ ⟨e',s'⟩"
proof (cases)
fix a
assume e': "e' = throw a"
assume "P ⊢ ⟨b,s⟩ ⇒ ⟨throw a,s'⟩"
hence "P ⊢ ⟨while(b) c,s⟩ ⇒ ⟨throw a,s'⟩" by (rule WhileCondThrow)
with e' show ?thesis by simp
next
fix s⇩1
assume eval_false: "P ⊢ ⟨b,s⟩ ⇒ ⟨false,s⇩1⟩"
and eval_unit: "P ⊢ ⟨unit,s⇩1⟩ ⇒ ⟨e',s'⟩"
with eval_unit have "s' = s⇩1" "e' = unit" by (auto elim: eval_cases)
moreover from eval_false have "P ⊢ ⟨while (b) c,s⟩ ⇒ ⟨unit,s⇩1⟩"
by - (rule WhileF, simp)
ultimately show ?thesis by simp
next
fix s⇩1
assume eval_true: "P ⊢ ⟨b,s⟩ ⇒ ⟨true,s⇩1⟩"
and eval_rest: "P ⊢ ⟨c;; while (b) c,s⇩1⟩⇒⟨e',s'⟩"
from eval_rest show ?thesis
proof (cases)
fix s⇩2 v⇩1
assume "P ⊢ ⟨c,s⇩1⟩ ⇒ ⟨Val v⇩1,s⇩2⟩" "P ⊢ ⟨while (b) c,s⇩2⟩ ⇒ ⟨e',s'⟩"
with eval_true show "P ⊢ ⟨while(b) c,s⟩ ⇒ ⟨e',s'⟩" by (rule WhileT)
next
fix a
assume "P ⊢ ⟨c,s⇩1⟩ ⇒ ⟨throw a,s'⟩" "e' = throw a"
with eval_true show "P ⊢ ⟨while(b) c,s⟩ ⇒ ⟨e',s'⟩"
by (iprover intro: WhileBodyThrow)
qed
qed
qed
lemma blocksEval:
"⋀Ts vs l l'. ⟦size ps = size Ts; size ps = size vs; P ⊢ ⟨blocks(ps,Ts,vs,e),(h,l,sh)⟩ ⇒ ⟨e',(h',l',sh')⟩ ⟧
⟹ ∃ l''. P ⊢ ⟨e,(h,l(ps[↦]vs),sh)⟩ ⇒ ⟨e',(h',l'',sh')⟩"
proof (induct ps)
case Nil then show ?case by fastforce
next
case (Cons p ps')
have length_eqs: "length (p # ps') = length Ts"
"length (p # ps') = length vs" by fact+
then obtain T Ts' where Ts: "Ts = T#Ts'" by (cases "Ts") simp
obtain v vs' where vs: "vs = v#vs'" using length_eqs by (cases "vs") simp
have "P ⊢ ⟨blocks (p # ps', Ts, vs, e),(h,l,sh)⟩ ⇒ ⟨e',(h', l',sh')⟩" by fact
with Ts vs
have "P ⊢ ⟨{p:T := Val v; blocks (ps', Ts', vs', e)},(h,l,sh)⟩ ⇒ ⟨e',(h', l',sh')⟩"
by simp
then obtain l''' where
eval_ps': "P ⊢ ⟨blocks (ps', Ts', vs', e),(h, l(p↦v), sh)⟩ ⇒ ⟨e',(h', l''', sh')⟩"
and l''': "l'=l'''(p:=l p)"
by (auto elim!: eval_cases)
then obtain l'' where
hyp: "P ⊢ ⟨e,(h, l(p↦v)(ps'[↦]vs'), sh)⟩ ⇒ ⟨e',(h', l'', sh')⟩"
using length_eqs Ts vs Cons.hyps [OF _ _ eval_ps'] by auto
from hyp
show "∃l''. P ⊢ ⟨e,(h, l(p # ps'[↦]vs), sh)⟩ ⇒ ⟨e',(h', l'', sh')⟩"
using Ts vs by auto
qed
lemma
assumes wf: "wwf_J_prog P"
shows eval_restrict_lcl:
"P ⊢ ⟨e,(h,l,sh)⟩ ⇒ ⟨e',(h',l',sh')⟩ ⟹ (⋀W. fv e ⊆ W ⟹ P ⊢ ⟨e,(h,l|`W,sh)⟩ ⇒ ⟨e',(h',l'|`W,sh')⟩)"
and "P ⊢ ⟨es,(h,l,sh)⟩ [⇒] ⟨es',(h',l',sh')⟩ ⟹ (⋀W. fvs es ⊆ W ⟹ P ⊢ ⟨es,(h,l|`W,sh)⟩ [⇒] ⟨es',(h',l'|`W,sh')⟩)"
proof(induct rule:eval_evals_inducts)
case (Block e⇩0 h⇩0 l⇩0 V sh⇩0 e⇩1 h⇩1 l⇩1 sh⇩1 T)
have IH: "⋀W. fv e⇩0 ⊆ W ⟹ P ⊢ ⟨e⇩0,(h⇩0,l⇩0(V:=None)|`W,sh⇩0)⟩ ⇒ ⟨e⇩1,(h⇩1,l⇩1|`W,sh⇩1)⟩" by fact
have "fv({V:T; e⇩0}) ⊆ W" by fact+
hence "fv e⇩0 - {V} ⊆ W" by simp_all
hence "fv e⇩0 ⊆ insert V W" by fast
from IH[OF this]
have "P ⊢ ⟨e⇩0,(h⇩0, (l⇩0|`W)(V := None), sh⇩0)⟩ ⇒ ⟨e⇩1,(h⇩1, l⇩1|`insert V W, sh⇩1)⟩"
by fastforce
from eval_evals.Block[OF this] show ?case by fastforce
next
case Seq thus ?case by simp (blast intro:eval_evals.Seq)
next
case New thus ?case by(simp add:eval_evals.intros)
next
case NewFail thus ?case by(simp add:eval_evals.intros)
next
case (NewInit sh C h l v' h' l' sh' a h'')
have "fv(INIT C ([C],False) ← unit) ⊆ W" by simp
then have "P ⊢ ⟨INIT C ([C],False) ← unit,(h, l |` W, sh)⟩ ⇒ ⟨Val v',(h', l' |` W, sh')⟩"
by (simp add: NewInit.hyps(3))
thus ?case using NewInit.hyps(1,4-6) eval_evals.NewInit by blast
next
case (NewInitOOM sh C h l v' h' l' sh')
have "fv(INIT C ([C],False) ← unit) ⊆ W" by simp
then have "P ⊢ ⟨INIT C ([C],False) ← unit,(h, l |` W, sh)⟩ ⇒ ⟨Val v',(h', l' |` W, sh')⟩"
by (simp add: NewInitOOM.hyps(3))
thus ?case
using NewInitOOM.hyps(1,4,5) eval_evals.NewInitOOM by auto
next
case NewInitThrow thus ?case by(simp add:eval_evals.intros)
next
case Cast thus ?case by simp (blast intro:eval_evals.Cast)
next
case CastNull thus ?case by simp (blast intro:eval_evals.CastNull)
next
case CastFail thus ?case by simp (blast intro:eval_evals.CastFail)
next
case CastThrow thus ?case by(simp add:eval_evals.intros)
next
case Val thus ?case by(simp add:eval_evals.intros)
next
case BinOp thus ?case by simp (blast intro:eval_evals.BinOp)
next
case BinOpThrow1 thus ?case by simp (blast intro:eval_evals.BinOpThrow1)
next
case BinOpThrow2 thus ?case by simp (blast intro:eval_evals.BinOpThrow2)
next
case Var thus ?case by(simp add:eval_evals.intros)
next
case (LAss e h⇩0 l⇩0 sh⇩0 v h l sh l' V)
have IH: "⋀W. fv e ⊆ W ⟹ P ⊢ ⟨e,(h⇩0,l⇩0|`W,sh⇩0)⟩ ⇒ ⟨Val v,(h,l|`W,sh)⟩"
and [simp]: "l' = l(V ↦ v)" by fact+
have "fv (V:=e) ⊆ W" by fact
hence fv: "fv e ⊆ W" and VinW: "V ∈ W" by auto
from eval_evals.LAss[OF IH[OF fv] refl, of V] VinW
show ?case by simp
next
case LAssThrow thus ?case by(fastforce intro: eval_evals.LAssThrow)
next
case FAcc thus ?case by simp (blast intro: eval_evals.FAcc)
next
case FAccNull thus ?case by(fastforce intro: eval_evals.FAccNull)
next
case FAccThrow thus ?case by(fastforce intro: eval_evals.FAccThrow)
next
case FAccNone thus ?case by(metis eval_evals.FAccNone fv.simps(7))
next
case FAccStatic thus ?case by(metis eval_evals.FAccStatic fv.simps(7))
next
case SFAcc thus ?case by simp (blast intro: eval_evals.SFAcc)
next
case SFAccInit thus ?case by simp (blast intro: eval_evals.SFAccInit)
next
case SFAccInitThrow thus ?case by simp (blast intro: eval_evals.SFAccInitThrow)
next
case SFAccNone thus ?case by simp (blast intro: eval_evals.SFAccNone)
next
case SFAccNonStatic thus ?case by simp (blast intro: eval_evals.SFAccNonStatic)
next
case FAss thus ?case by simp (blast intro: eval_evals.FAss)
next
case FAssNull thus ?case by simp (blast intro: eval_evals.FAssNull)
next
case FAssThrow1 thus ?case by simp (blast intro: eval_evals.FAssThrow1)
next
case FAssThrow2 thus ?case by simp (blast intro: eval_evals.FAssThrow2)
next
case FAssNone thus ?case by simp (blast intro: eval_evals.FAssNone)
next
case FAssStatic thus ?case by simp (blast intro: eval_evals.FAssStatic)
next
case SFAss thus ?case by simp (blast intro: eval_evals.SFAss)
next
case SFAssInit thus ?case by simp (blast intro: eval_evals.SFAssInit)
next
case SFAssInitThrow thus ?case by simp (blast intro: eval_evals.SFAssInitThrow)
next
case SFAssThrow thus ?case by simp (blast intro: eval_evals.SFAssThrow)
next
case SFAssNone thus ?case by simp (blast intro: eval_evals.SFAssNone)
next
case SFAssNonStatic thus ?case by simp (blast intro: eval_evals.SFAssNonStatic)
next
case CallObjThrow thus ?case by simp (blast intro: eval_evals.intros)
next
case CallNull thus ?case by simp (blast intro: eval_evals.CallNull)
next
case (CallNone e h l sh a h' l' sh' ps vs h⇩2 l⇩2 sh⇩2 C fs M)
have f1: "P ⊢ ⟨e,(h, l |` W, sh)⟩ ⇒ ⟨addr a,(h', l' |` W, sh')⟩"
by (metis (no_types) fv.simps(11) le_sup_iff local.CallNone(2) local.CallNone(7))
have "P ⊢ ⟨ps,(h', l' |` W, sh')⟩ [⇒] ⟨map Val vs, (h⇩2, l⇩2 |` W, sh⇩2)⟩"
using local.CallNone(4) local.CallNone(7) by auto
then show ?case
using f1 eval_evals.CallNone local.CallNone(5) local.CallNone(6) by auto
next
case CallStatic thus ?case
by (metis (no_types, lifting) eval_evals.CallStatic fv.simps(11) le_sup_iff)
next
case CallParamsThrow thus ?case
by simp (blast intro: eval_evals.CallParamsThrow)
next
case (Call e h⇩0 l⇩0 sh⇩0 a h⇩1 l⇩1 sh⇩1 ps vs h⇩2 l⇩2 sh⇩2 C fs M Ts T pns body
D l⇩2' e' h⇩3 l⇩3 sh⇩3)
have IHe: "⋀W. fv e ⊆ W ⟹ P ⊢ ⟨e,(h⇩0,l⇩0|`W,sh⇩0)⟩ ⇒ ⟨addr a,(h⇩1,l⇩1|`W,sh⇩1)⟩"
and IHps: "⋀W. fvs ps ⊆ W ⟹ P ⊢ ⟨ps,(h⇩1,l⇩1|`W,sh⇩1)⟩ [⇒] ⟨map Val vs,(h⇩2,l⇩2|`W,sh⇩2)⟩"
and IHbd: "⋀W. fv body ⊆ W ⟹ P ⊢ ⟨body,(h⇩2,l⇩2'|`W,sh⇩2)⟩ ⇒ ⟨e',(h⇩3,l⇩3|`W,sh⇩3)⟩"
and h⇩2a: "h⇩2 a = Some (C, fs)"
and "method": "P ⊢ C sees M,NonStatic: Ts→T = (pns, body) in D"
and same_len: "size vs = size pns"
and l⇩2': "l⇩2' = [this ↦ Addr a, pns [↦] vs]" by fact+
have "fv (e∙M(ps)) ⊆ W" by fact
hence fve: "fv e ⊆ W" and fvps: "fvs(ps) ⊆ W" by auto
have wfmethod: "size Ts = size pns ∧ this ∉ set pns" and
fvbd: "fv body ⊆ {this} ∪ set pns"
using "method" wf by(fastforce dest!:sees_wf_mdecl simp:wf_mdecl_def)+
show ?case
using IHbd[OF fvbd] l⇩2' same_len wfmethod h⇩2a
eval_evals.Call[OF IHe[OF fve] IHps[OF fvps] _ "method" same_len l⇩2']
by (simp add:subset_insertI)
next
case (SCallNone ps h l sh vs h' l' sh' C M)
have "P ⊢ ⟨ps,(h, l |` W, sh)⟩ [⇒] ⟨map Val vs,(h', l' |` W, sh')⟩"
using SCallNone.hyps(2) SCallNone.prems by auto
then show ?case using SCallNone.hyps(3) eval_evals.SCallNone by auto
next
case SCallNonStatic thus ?case by (metis eval_evals.SCallNonStatic fv.simps(12))
next
case SCallParamsThrow thus ?case
by simp (blast intro: eval_evals.SCallParamsThrow)
next
case SCallInitThrow thus ?case by simp (blast intro: eval_evals.SCallInitThrow)
next
case SCallInit thus ?case by simp (blast intro: eval_evals.SCallInit)
next
case (SCall ps h⇩0 l⇩0 sh⇩0 vs h⇩2 l⇩2 sh⇩2 C M Ts T pns body D sfs l⇩2' e' h⇩3 l⇩3 sh⇩3)
have IHps: "⋀W. fvs ps ⊆ W ⟹ P ⊢ ⟨ps,(h⇩0,l⇩0|`W,sh⇩0)⟩ [⇒] ⟨map Val vs,(h⇩2,l⇩2|`W,sh⇩2)⟩"
and IHbd: "⋀W. fv body ⊆ W ⟹ P ⊢ ⟨body,(h⇩2,l⇩2'|`W,sh⇩2)⟩ ⇒ ⟨e',(h⇩3,l⇩3|`W,sh⇩3)⟩"
and sh⇩2D: "sh⇩2 D = Some (sfs, Done) ∨ M = clinit ∧ sh⇩2 D = ⌊(sfs, Processing)⌋"
and "method": "P ⊢ C sees M,Static: Ts→T = (pns, body) in D"
and same_len: "size vs = size pns"
and l⇩2': "l⇩2' = [pns [↦] vs]" by fact+
have "fv (C∙⇩sM(ps)) ⊆ W" by fact
hence fvps: "fvs(ps) ⊆ W" by auto
have wfmethod: "size Ts = size pns" and fvbd: "fv body ⊆ set pns"
using "method" wf by(fastforce dest!:sees_wf_mdecl simp:wf_mdecl_def)+
show ?case
using IHbd[OF fvbd] l⇩2' same_len wfmethod sh⇩2D
eval_evals.SCall[OF IHps[OF fvps] "method" _ same_len l⇩2']
by (simp add:subset_insertI)
next
case SeqThrow thus ?case by simp (blast intro: eval_evals.SeqThrow)
next
case CondT thus ?case by simp (blast intro: eval_evals.CondT)
next
case CondF thus ?case by simp (blast intro: eval_evals.CondF)
next
case CondThrow thus ?case by simp (blast intro: eval_evals.CondThrow)
next
case WhileF thus ?case by simp (blast intro: eval_evals.WhileF)
next
case WhileT thus ?case by simp (blast intro: eval_evals.WhileT)
next
case WhileCondThrow thus ?case by simp (blast intro: eval_evals.WhileCondThrow)
next
case WhileBodyThrow thus ?case by simp (blast intro: eval_evals.WhileBodyThrow)
next
case Throw thus ?case by simp (blast intro: eval_evals.Throw)
next
case ThrowNull thus ?case by simp (blast intro: eval_evals.ThrowNull)
next
case ThrowThrow thus ?case by simp (blast intro: eval_evals.ThrowThrow)
next
case Try thus ?case by simp (blast intro: eval_evals.Try)
next
case (TryCatch e⇩1 h⇩0 l⇩0 sh⇩0 a h⇩1 l⇩1 sh⇩1 D fs C e⇩2 V e⇩2' h⇩2 l⇩2 sh⇩2)
have IH⇩1: "⋀W. fv e⇩1 ⊆ W ⟹ P ⊢ ⟨e⇩1,(h⇩0,l⇩0|`W,sh⇩0)⟩ ⇒ ⟨Throw a,(h⇩1,l⇩1|`W,sh⇩1)⟩"
and IH⇩2: "⋀W. fv e⇩2 ⊆ W ⟹ P ⊢ ⟨e⇩2,(h⇩1,l⇩1(V↦Addr a)|`W,sh⇩1)⟩ ⇒ ⟨e⇩2',(h⇩2,l⇩2|`W,sh⇩2)⟩"
and lookup: "h⇩1 a = Some(D, fs)" and subtype: "P ⊢ D ≼⇧* C" by fact+
have "fv (try e⇩1 catch(C V) e⇩2) ⊆ W" by fact
hence fv⇩1: "fv e⇩1 ⊆ W" and fv⇩2: "fv e⇩2 ⊆ insert V W" by auto
have IH⇩2': "P ⊢ ⟨e⇩2,(h⇩1,(l⇩1|`W)(V ↦ Addr a),sh⇩1)⟩ ⇒ ⟨e⇩2',(h⇩2,l⇩2|`insert V W,sh⇩2)⟩"
using IH⇩2[OF fv⇩2] fun_upd_restrict[of l⇩1 W] by simp
with eval_evals.TryCatch[OF IH⇩1[OF fv⇩1] _ subtype IH⇩2'] lookup
show ?case by fastforce
next
case TryThrow thus ?case by simp (blast intro: eval_evals.TryThrow)
next
case Nil thus ?case by (simp add: eval_evals.Nil)
next
case Cons thus ?case by simp (blast intro: eval_evals.Cons)
next
case ConsThrow thus ?case by simp (blast intro: eval_evals.ConsThrow)
next
case InitFinal thus ?case by (simp add: eval_evals.InitFinal)
next
case InitNone thus ?case by(blast intro: eval_evals.InitNone)
next
case InitDone thus ?case
by (simp add: InitDone.hyps(2) InitDone.prems eval_evals.InitDone)
next
case InitProcessing thus ?case by (simp add: eval_evals.InitProcessing)
next
case InitError thus ?case using eval_evals.InitError by auto
next
case InitObject thus ?case by(simp add: eval_evals.InitObject)
next
case InitNonObject thus ?case by(simp add: eval_evals.InitNonObject)
next
case InitRInit thus ?case by(simp add: eval_evals.InitRInit)
next
case (RInit e h l sh v h' l' sh' C sfs i sh'' C' Cs e' e⇩1 h⇩1 l⇩1 sh⇩1)
have f1: "fv e ⊆ W ∧ fv (INIT C' (Cs,True) ← e') ⊆ W"
using RInit.prems by auto
then have f2: "P ⊢ ⟨e,(h, l |` W, sh)⟩ ⇒ ⟨Val v,(h', l' |` W, sh')⟩"
using RInit.hyps(2) by blast
have "P ⊢ ⟨INIT C' (Cs,True) ← e', (h', l' |` W, sh'')⟩ ⇒ ⟨e⇩1,(h⇩1, l⇩1 |` W, sh⇩1)⟩"
using f1 by (meson RInit.hyps(7))
then show ?case
using f2 RInit.hyps(3) RInit.hyps(4) RInit.hyps(5) eval_evals.RInit by blast
next
case (RInitInitFail e h l sh a h' l' sh' C sfs i sh'' D Cs e' e⇩1 h⇩1 l⇩1 sh⇩1)
have f1: "fv e ⊆ W" "fv e' ⊆ W"
using RInitInitFail.prems by auto
then have f2: "P ⊢ ⟨e,(h, l |` W, sh)⟩ ⇒ ⟨throw a,(h', l' |` W, sh')⟩"
using RInitInitFail.hyps(2) by blast
then have f2': "fv (throw a) ⊆ W"
using eval_final[OF f2] by auto
then have f1': "fv (RI (D,throw a);Cs ← e') ⊆ W"
using f1 by auto
have "P ⊢ ⟨RI (D,throw a);Cs ← e', (h', l' |` W, sh'')⟩ ⇒ ⟨e⇩1,(h⇩1, l⇩1 |` W, sh⇩1)⟩"
using f1' by (meson RInitInitFail.hyps(6))
then show ?case
using f2 by (simp add: RInitInitFail.hyps(3,4) eval_evals.RInitInitFail)
next
case (RInitFailFinal e h l sh a h' l' sh' sh'' C)
have f1: "fv e ⊆ W"
using RInitFailFinal.prems by auto
then have f2: "P ⊢ ⟨e,(h, l |` W, sh)⟩ ⇒ ⟨throw a,(h', l' |` W, sh')⟩"
using RInitFailFinal.hyps(2) by blast
then have f2': "fv (throw a) ⊆ W"
using eval_final[OF f2] by auto
then show ?case using f2 RInitFailFinal.hyps(3,4) eval_evals.RInitFailFinal by blast
qed
lemma eval_notfree_unchanged:
"P ⊢ ⟨e,(h,l,sh)⟩ ⇒ ⟨e',(h',l',sh')⟩ ⟹ (⋀V. V ∉ fv e ⟹ l' V = l V)"
and "P ⊢ ⟨es,(h,l,sh)⟩ [⇒] ⟨es',(h',l',sh')⟩ ⟹ (⋀V. V ∉ fvs es ⟹ l' V = l V)"
proof(induct rule:eval_evals_inducts)
case LAss thus ?case by(simp add:fun_upd_apply)
next
case Block thus ?case
by (simp only:fun_upd_apply split:if_splits) fastforce
next
case TryCatch thus ?case
by (simp only:fun_upd_apply split:if_splits) fastforce
next
case (RInitInitFail e h l sh a h' l' sh' C sfs i sh'' D Cs e⇩1 h⇩1 l⇩1 sh⇩1)
have "fv (throw a) = {}"
using RInitInitFail.hyps(1) eval_final final_fv by blast
then have "fv e ∪ fv (RI (D,throw a) ; Cs ← unit) ⊆ fv (RI (C,e) ; D#Cs ← unit)"
by auto
then show ?case using RInitInitFail.hyps(2,6) RInitInitFail.prems by fastforce
qed simp_all
lemma eval_closed_lcl_unchanged:
"⟦ P ⊢ ⟨e,(h,l,sh)⟩ ⇒ ⟨e',(h',l',sh')⟩; fv e = {} ⟧ ⟹ l' = l"
by(fastforce dest:eval_notfree_unchanged simp add:fun_eq_iff [where 'b="val option"])
lemma list_eval_Throw:
assumes eval_e: "P ⊢ ⟨throw x,s⟩ ⇒ ⟨e',s'⟩"
shows "P ⊢ ⟨map Val vs @ throw x # es',s⟩ [⇒] ⟨map Val vs @ e' # es',s'⟩"
proof -
from eval_e
obtain a where e': "e' = Throw a"
by (cases) (auto dest!: eval_final)
{
fix es
have "⋀vs. es = map Val vs @ throw x # es'
⟹ P ⊢ ⟨es,s⟩[⇒]⟨map Val vs @ e' # es',s'⟩"
proof (induct es type: list)
case Nil thus ?case by simp
next
case (Cons e es vs)
have e_es: "e # es = map Val vs @ throw x # es'" by fact
show "P ⊢ ⟨e # es,s⟩ [⇒] ⟨map Val vs @ e' # es',s'⟩"
proof (cases vs)
case Nil
with e_es obtain "e=throw x" "es=es'" by simp
moreover from eval_e e'
have "P ⊢ ⟨throw x # es,s⟩ [⇒] ⟨Throw a # es,s'⟩"
by (iprover intro: ConsThrow)
ultimately show ?thesis using Nil e' by simp
next
case (Cons v vs')
have vs: "vs = v # vs'" by fact
with e_es obtain
e: "e=Val v" and es:"es= map Val vs' @ throw x # es'"
by simp
from e
have "P ⊢ ⟨e,s⟩ ⇒ ⟨Val v,s⟩"
by (iprover intro: eval_evals.Val)
moreover from es
have "P ⊢ ⟨es,s⟩ [⇒] ⟨map Val vs' @ e' # es',s'⟩"
by (rule Cons.hyps)
ultimately show
"P ⊢ ⟨e#es,s⟩ [⇒] ⟨map Val vs @ e' # es',s'⟩"
using vs by (auto intro: eval_evals.Cons)
qed
qed
}
thus ?thesis
by simp
qed
lemma seq_ext:
assumes IH: "⋀e' s'. P ⊢ ⟨e'',s''⟩ ⇒ ⟨e',s'⟩ ⟹ P ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩"
and seq: "P ⊢ ⟨e'' ;; e⇩0,s''⟩ ⇒ ⟨e',s'⟩"
shows "P ⊢ ⟨e ;; e⇩0,s⟩ ⇒ ⟨e',s'⟩"
proof(rule eval_cases(14)[OF seq])
fix v' s⇩1 assume e'': "P ⊢ ⟨e'',s''⟩ ⇒ ⟨Val v',s⇩1⟩" and estep: "P ⊢ ⟨e⇩0,s⇩1⟩ ⇒ ⟨e',s'⟩"
have "P ⊢ ⟨e,s⟩ ⇒ ⟨Val v',s⇩1⟩" using e'' IH by simp
then show ?thesis using estep Seq by simp
next
fix e⇩t assume e'': "P ⊢ ⟨e'',s''⟩ ⇒ ⟨throw e⇩t,s'⟩" and e': "e' = throw e⇩t"
have "P ⊢ ⟨e,s⟩ ⇒ ⟨throw e⇩t,s'⟩" using e'' IH by simp
then show ?thesis using eval_evals.SeqThrow e' by simp
qed
lemma rinit_Val_ext:
assumes ri: "P ⊢ ⟨RI (C,e'') ; Cs ← e⇩0,s''⟩ ⇒ ⟨Val v',s⇩1⟩"
and IH: "⋀e' s'. P ⊢ ⟨e'',s''⟩ ⇒ ⟨e',s'⟩ ⟹ P ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩"
shows "P ⊢ ⟨RI (C,e) ; Cs ← e⇩0,s⟩ ⇒ ⟨Val v',s⇩1⟩"
proof(rule eval_cases(20)[OF ri])
fix v'' h' l' sh' sfs i
assume e''step: "P ⊢ ⟨e'',s''⟩ ⇒ ⟨Val v'',(h', l', sh')⟩"
and shC: "sh' C = ⌊(sfs, i)⌋"
and init: "P ⊢ ⟨INIT (if Cs = [] then C else last Cs) (Cs,True) ← e⇩0,(h', l', sh'(C ↦ (sfs, Done)))⟩ ⇒
⟨Val v',s⇩1⟩"
have "P ⊢ ⟨e,s⟩ ⇒ ⟨Val v'',(h', l', sh')⟩" using IH[OF e''step] by simp
then show ?thesis using RInit init shC by auto
next
fix a h' l' sh' sfs i D Cs'
assume e''step: "P ⊢ ⟨e'',s''⟩ ⇒ ⟨throw a,(h', l', sh')⟩"
and riD: "P ⊢ ⟨RI (D,throw a) ; Cs' ← e⇩0,(h', l', sh'(C ↦ (sfs, Error)))⟩ ⇒ ⟨Val v',s⇩1⟩"
have "P ⊢ ⟨e,s⟩ ⇒ ⟨throw a,(h', l', sh')⟩" using IH[OF e''step] by simp
then show ?thesis using riD rinit_throwE by blast
qed(simp)
lemma rinit_throw_ext:
assumes ri: "P ⊢ ⟨RI (C,e'') ; Cs ← e⇩0,s''⟩ ⇒ ⟨throw e⇩t,s'⟩"
and IH: "⋀e' s'. P ⊢ ⟨e'',s''⟩ ⇒ ⟨e',s'⟩ ⟹ P ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩"
shows "P ⊢ ⟨RI (C,e) ; Cs ← e⇩0,s⟩ ⇒ ⟨throw e⇩t,s'⟩"
proof(rule eval_cases(20)[OF ri])
fix v h' l' sh' sfs i
assume e''step: "P ⊢ ⟨e'',s''⟩ ⇒ ⟨Val v,(h', l', sh')⟩"
and shC: "sh' C = ⌊(sfs, i)⌋"
and init: "P ⊢ ⟨INIT (if Cs = [] then C else last Cs) (Cs,True) ← e⇩0,(h', l', sh'(C ↦ (sfs, Done)))⟩ ⇒
⟨throw e⇩t,s'⟩"
have "P ⊢ ⟨e,s⟩ ⇒ ⟨Val v,(h', l', sh')⟩" using IH[OF e''step] by simp
then show ?thesis using RInit init shC by auto
next
fix a h' l' sh' sfs i D Cs'
assume e''step: "P ⊢ ⟨e'',s''⟩ ⇒ ⟨throw a,(h', l', sh')⟩"
and shC: "sh' C = ⌊(sfs, i)⌋"
and riD: "P ⊢ ⟨RI (D,throw a) ; Cs' ← e⇩0,(h', l', sh'(C ↦ (sfs, Error)))⟩ ⇒ ⟨throw e⇩t,s'⟩"
and cons: "Cs = D # Cs'"
have estep': "P ⊢ ⟨e,s⟩ ⇒ ⟨throw a,(h', l', sh')⟩" using IH[OF e''step] by simp
then show ?thesis using RInitInitFail cons riD shC by simp
next
fix a h' l' sh' sfs i
assume "throw e⇩t = throw a"
and "s' = (h', l', sh'(C ↦ (sfs, Error)))"
and "P ⊢ ⟨e'',s''⟩ ⇒ ⟨throw a,(h', l', sh')⟩"
and "sh' C = ⌊(sfs, i)⌋"
and "Cs = []"
then show ?thesis using RInitFailFinal IH by auto
qed
lemma rinit_ext:
assumes IH: "⋀e' s'. P ⊢ ⟨e'',s''⟩ ⇒ ⟨e',s'⟩ ⟹ P ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩"
shows "⋀e' s'. P ⊢ ⟨RI (C,e'') ; Cs ← e⇩0,s''⟩ ⇒ ⟨e',s'⟩
⟹ P ⊢ ⟨RI (C,e) ; Cs ← e⇩0,s⟩ ⇒ ⟨e',s'⟩"
proof -
fix e' s' assume ri'': "P ⊢ ⟨RI (C,e'') ; Cs ← e⇩0,s''⟩ ⇒ ⟨e',s'⟩"
then have "final e'" using eval_final by simp
then show "P ⊢ ⟨RI (C,e) ; Cs ← e⇩0,s⟩ ⇒ ⟨e',s'⟩"
proof(rule finalE)
fix v assume "e' = Val v" then show ?thesis using rinit_Val_ext[OF _ IH] ri'' by simp
next
fix a assume "e' = throw a" then show ?thesis using rinit_throw_ext[OF _ IH] ri'' by simp
qed
qed
lemma
shows eval_init_return: "P ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩
⟹ iconf (shp s) e
⟹ (∃Cs b. e = INIT C' (Cs,b) ← unit) ∨ (∃C e⇩0 Cs e⇩i. e = RI(C,e⇩0);Cs@[C'] ← unit)
∨ (∃e⇩0. e = RI(C',e⇩0);Nil ← unit)
⟹ (val_of e' = Some v ⟶ (∃sfs i. shp s' C' = ⌊(sfs,i)⌋ ∧ (i = Done ∨ i = Processing)))
∧ (throw_of e' = Some a ⟶ (∃sfs i. shp s' C' = ⌊(sfs,Error)⌋))"
and "P ⊢ ⟨es,s⟩ [⇒] ⟨es',s'⟩ ⟹ True"
proof(induct rule: eval_evals.inducts)
case (InitFinal e s e' s' C b) then show ?case
by(fastforce simp: initPD_def dest: eval_final_same)
next
case (InitDone sh C sfs C' Cs e h l e' s')
then have "final e'" using eval_final by simp
then show ?case
proof(rule finalE)
fix v assume e': "e' = Val v" then show ?thesis using InitDone initPD_def
proof(cases Cs) qed(auto)
next
fix a assume e': "e' = throw a" then show ?thesis using InitDone initPD_def
proof(cases Cs) qed(auto)
qed
next
case (InitProcessing sh C sfs C' Cs e h l e' s')
then have "final e'" using eval_final by simp
then show ?case
proof(rule finalE)
fix v assume e': "e' = Val v" then show ?thesis using InitProcessing initPD_def
proof(cases Cs) qed(auto)
next
fix a assume e': "e' = throw a" then show ?thesis using InitProcessing initPD_def
proof(cases Cs) qed(auto)
qed
next
case (InitError sh C sfs Cs e h l e' s' C') show ?case
proof(cases Cs)
case Nil then show ?thesis using InitError by simp
next
case (Cons C2 list)
then have "final e'" using InitError eval_final by simp
then show ?thesis
proof(rule finalE)
fix v assume e': "e' = Val v" then show ?thesis
using InitError
proof -
obtain ccss :: "char list list" and bb :: bool where
"INIT C' (C # Cs,False) ← e = INIT C' (ccss,bb) ← unit"
using InitError.prems(2) by blast
then show ?thesis using InitError.hyps(2) e' by(auto dest!: rinit_throwE)
qed
next
fix a assume e': "e' = throw a"
then show ?thesis using Cons InitError cons_to_append[of list] by clarsimp
qed
qed
next
case (InitRInit C Cs h l sh e' s' C') show ?case
proof(cases Cs)
case Nil then show ?thesis using InitRInit by simp
next
case (Cons C' list) then show ?thesis
using InitRInit Cons cons_to_append[of list] by clarsimp
qed
next
case (RInit e s v h' l' sh' C sfs i sh'' C' Cs e' e⇩1 s⇩1)
then have final: "final e⇩1" using eval_final by simp
then show ?case
proof(cases Cs)
case Nil show ?thesis using final
proof(rule finalE)
fix v assume e': "e⇩1 = Val v" show ?thesis
using RInit Nil by(auto simp: fun_upd_same initPD_def)
next
fix a assume e': "e⇩1 = throw a" show ?thesis
using RInit Nil by(auto simp: fun_upd_same initPD_def)
qed
next
case (Cons a list) show ?thesis
proof(rule finalE[OF final])
fix v assume e': "e⇩1 = Val v" then show ?thesis
using RInit Cons by clarsimp (metis last.simps last_appendR list.distinct(1))
next
fix a assume e': "e⇩1 = throw a" then show ?thesis
using RInit Cons by clarsimp (metis last.simps last_appendR list.distinct(1))
qed
qed
next
case (RInitInitFail e s a h' l' sh' C sfs i sh'' D Cs e' e⇩1 s⇩1)
then have final: "final e⇩1" using eval_final by simp
then show ?case
proof(rule finalE)
fix v assume e': "e⇩1 = Val v" then show ?thesis
using RInitInitFail by clarsimp (meson exp.distinct(101) rinit_throwE)
next
fix a' assume e': "e⇩1 = Throw a'"
then have "iconf (sh'(C ↦ (sfs, Error))) a"
using RInitInitFail.hyps(1) eval_final by fastforce
then show ?thesis using RInitInitFail e'
by clarsimp (meson Cons_eq_append_conv list.inject)
qed
qed(auto simp: fun_upd_same)
lemma init_Val_PD: "P ⊢ ⟨INIT C' (Cs,b) ← unit,s⟩ ⇒ ⟨Val v,s'⟩
⟹ iconf (shp s) (INIT C' (Cs,b) ← unit)
⟹ ∃sfs i. shp s' C' = ⌊(sfs,i)⌋ ∧ (i = Done ∨ i = Processing)"
by(drule_tac v = v in eval_init_return, simp+)
lemma init_throw_PD: "P ⊢ ⟨INIT C' (Cs,b) ← unit,s⟩ ⇒ ⟨throw a,s'⟩
⟹ iconf (shp s) (INIT C' (Cs,b) ← unit)
⟹ ∃sfs i. shp s' C' = ⌊(sfs,Error)⌋"
by(drule_tac a = a in eval_init_return, simp+)
lemma rinit_Val_PD: "P ⊢ ⟨RI(C,e⇩0);Cs ← unit,s⟩ ⇒ ⟨Val v,s'⟩
⟹ iconf (shp s) (RI(C,e⇩0);Cs ← unit) ⟹ last(C#Cs) = C'
⟹ ∃sfs i. shp s' C' = ⌊(sfs,i)⌋ ∧ (i = Done ∨ i = Processing)"
apply(drule_tac C' = C' and v = v in eval_init_return, simp_all)
apply (metis append_butlast_last_id)
done
lemma rinit_throw_PD: "P ⊢ ⟨RI(C,e⇩0);Cs ← unit,s⟩ ⇒ ⟨throw a,s'⟩
⟹ iconf (shp s) (RI(C,e⇩0);Cs ← unit) ⟹ last(C#Cs) = C'
⟹ ∃sfs i. shp s' C' = ⌊(sfs,Error)⌋"
apply(drule_tac C' = C' and a = a in eval_init_return, simp_all)
apply (metis append_butlast_last_id)
done
declare split_paired_All [simp del] split_paired_Ex [simp del]
lemma eval_init_seq': "P ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩
⟹ (∃C Cs b e⇩i. e = INIT C (Cs,b) ← e⇩i) ∨ (∃C e⇩0 Cs e⇩i. e = RI(C,e⇩0);Cs ← e⇩i)
⟹ (∃C Cs b e⇩i. e = INIT C (Cs,b) ← e⇩i ∧ P ⊢ ⟨(INIT C (Cs,b) ← unit);; e⇩i,s⟩ ⇒ ⟨e',s'⟩)
∨ (∃C e⇩0 Cs e⇩i. e = RI(C,e⇩0);Cs ← e⇩i ∧ P ⊢ ⟨(RI(C,e⇩0);Cs ← unit);; e⇩i,s⟩ ⇒ ⟨e',s'⟩)"
and "P ⊢ ⟨es,s⟩ [⇒] ⟨es',s'⟩ ⟹ True"
proof(induct rule: eval_evals.inducts)
case InitFinal then show ?case by(auto simp: Seq[OF eval_evals.InitFinal[OF Val[where v=Unit]]])
next
case (InitNone sh) then show ?case
using seq_ext[OF eval_evals.InitNone[where sh=sh and e=unit, OF InitNone.hyps(1)]] by fastforce
next
case (InitDone sh) then show ?case
using seq_ext[OF eval_evals.InitDone[where sh=sh and e=unit, OF InitDone.hyps(1)]] by fastforce
next
case (InitProcessing sh) then show ?case
using seq_ext[OF eval_evals.InitProcessing[where sh=sh and e=unit, OF InitProcessing.hyps(1)]]
by fastforce
next
case (InitError sh) then show ?case
using seq_ext[OF eval_evals.InitError[where sh=sh and e=unit, OF InitError.hyps(1)]] by fastforce
next
case (InitObject sh) then show ?case
using seq_ext[OF eval_evals.InitObject[where sh=sh and e=unit, OF InitObject.hyps(1)]]
by fastforce
next
case (InitNonObject sh) then show ?case
using seq_ext[OF eval_evals.InitNonObject[where sh=sh and e=unit, OF InitNonObject.hyps(1)]]
by fastforce
next
case (InitRInit C Cs e h l sh e' s' C') then show ?case
using seq_ext[OF eval_evals.InitRInit[where e=unit]] by fastforce
next
case RInit then show ?case
using seq_ext[OF eval_evals.RInit[where e=unit, OF RInit.hyps(1)]] by fastforce
next
case RInitInitFail then show ?case
using seq_ext[OF eval_evals.RInitInitFail[where e=unit, OF RInitInitFail.hyps(1)]] by fastforce
next
case RInitFailFinal
then show ?case using eval_evals.RInitFailFinal eval_evals.SeqThrow by auto
qed(auto)
lemma eval_init_seq: "P ⊢ ⟨INIT C (Cs,b) ← e,(h, l, sh)⟩ ⇒ ⟨e',s'⟩
⟹ P ⊢ ⟨(INIT C (Cs,b) ← unit);; e,(h, l, sh)⟩ ⇒ ⟨e',s'⟩"
by(auto dest: eval_init_seq')
text ‹ The key lemma: ›
lemma
assumes wf: "wwf_J_prog P"
shows extend_1_eval: "P ⊢ ⟨e,s,b⟩ → ⟨e'',s'',b''⟩ ⟹ P,shp s ⊢⇩b (e,b) √
⟹ (⋀s' e'. P ⊢ ⟨e'',s''⟩ ⇒ ⟨e',s'⟩ ⟹ P ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩)"
and extend_1_evals: "P ⊢ ⟨es,s,b⟩ [→] ⟨es'',s'',b''⟩ ⟹ P,shp s ⊢⇩b (es,b) √
⟹ (⋀s' es'. P ⊢ ⟨es'',s''⟩ [⇒] ⟨es',s'⟩ ⟹ P ⊢ ⟨es,s⟩ [⇒] ⟨es',s'⟩)"
proof (induct rule: red_reds.inducts)
case (RedNew h a C FDTs h' l sh)
then have e':"e' = addr a" and s':"s' = (h(a ↦ blank P C), l, sh)"
using eval_cases(3) by fastforce+
obtain sfs i where shC: "sh C = ⌊(sfs, i)⌋" and "i = Done ∨ i = Processing"
using RedNew by (clarsimp simp: bconf_def initPD_def)
then show ?case
proof(cases i)
case Done then show ?thesis using RedNew shC e' s' New by simp
next
case Processing
then have shC': "∄sfs. sh C = Some(sfs,Done)" and shP: "sh C = Some(sfs,Processing)"
using shC by simp+
then have init: "P ⊢ ⟨INIT C ([C],False) ← unit,(h,l,sh)⟩ ⇒ ⟨unit,(h,l,sh)⟩"
by(simp add: InitFinal InitProcessing Val)
have "P ⊢ ⟨new C,(h, l, sh)⟩ ⇒ ⟨addr a,(h(a ↦ blank P C),l,sh)⟩"
using RedNew shC' by(auto intro: NewInit[OF _ init])
then show ?thesis using e' s' by simp
qed(auto)
next
case (RedNewFail h C l sh)
then have e':"e' = THROW OutOfMemory" and s':"s' = (h, l, sh)"
using eval_final_same final_def by fastforce+
obtain sfs i where shC: "sh C = ⌊(sfs, i)⌋" and "i = Done ∨ i = Processing"
using RedNewFail by (clarsimp simp: bconf_def initPD_def)
then show ?case
proof(cases i)
case Done then show ?thesis using RedNewFail shC e' s' NewFail by simp
next
case Processing
then have shC': "∄sfs. sh C = Some(sfs,Done)" and shP: "sh C = Some(sfs,Processing)"
using shC by simp+
then have init: "P ⊢ ⟨INIT C ([C],False) ← unit,(h,l,sh)⟩ ⇒ ⟨unit,(h,l,sh)⟩"
by(simp add: InitFinal InitProcessing Val)
have "P ⊢ ⟨new C,(h, l, sh)⟩ ⇒ ⟨THROW OutOfMemory,(h,l,sh)⟩"
using RedNewFail shC' by(auto intro: NewInitOOM[OF _ init])
then show ?thesis using e' s' by simp
qed(auto)
next
case (NewInitRed sh C h l)
then have seq: "P ⊢ ⟨(INIT C ([C],False) ← unit);; new C,(h, l, sh)⟩ ⇒ ⟨e',s'⟩"
using eval_init_seq by simp
then show ?case
proof(rule eval_cases(14))
fix v s⇩1 assume init: "P ⊢ ⟨INIT C ([C],False) ← unit,(h, l, sh)⟩ ⇒ ⟨Val v,s⇩1⟩"
and new: "P ⊢ ⟨new C,s⇩1⟩ ⇒ ⟨e',s'⟩"
obtain h⇩1 l⇩1 sh⇩1 where s⇩1: "s⇩1 = (h⇩1,l⇩1,sh⇩1)" by(cases s⇩1)
then obtain sfs i where shC: "sh⇩1 C = ⌊(sfs, i)⌋" and iDP: "i = Done ∨ i = Processing"
using init_Val_PD[OF init] by auto
show ?thesis
proof(rule eval_cases(1)[OF new])
fix sha ha a FDTs la
assume s⇩1a: "s⇩1 = (ha, la, sha)" and e': "e' = addr a"
and s': "s' = (ha(a ↦ blank P C), la, sha)"
and addr: "new_Addr ha = ⌊a⌋" and fields: "P ⊢ C has_fields FDTs"
then show ?thesis using NewInit[OF _ _ addr fields] NewInitRed.hyps init by simp
next
fix sha ha la
assume "s⇩1 = (ha, la, sha)" and "e' = THROW OutOfMemory"
and "s' = (ha, la, sha)" and "new_Addr ha = None"
then show ?thesis using NewInitOOM NewInitRed.hyps init by simp
next
fix sha ha la v' h' l' sh' a FDTs
assume s⇩1a: "s⇩1 = (ha, la, sha)" and e': "e' = addr a"
and s': "s' = (h'(a ↦ blank P C), l', sh')"
and shaC: "∀sfs. sha C ≠ ⌊(sfs, Done)⌋"
and init': "P ⊢ ⟨INIT C ([C],False) ← unit,(ha, la, sha)⟩ ⇒ ⟨Val v',(h', l', sh')⟩"
and addr: "new_Addr h' = ⌊a⌋" and fields: "P ⊢ C has_fields FDTs"
then have i: "i = Processing" using iDP shC s⇩1 by simp
then have "(h', l', sh') = (ha, la, sha)" using init' init_ProcessingE s⇩1 s⇩1a shC by blast
then show ?thesis using NewInit NewInitRed.hyps s⇩1a addr fields init shaC e' s' by auto
next
fix sha ha la v' h' l' sh'
assume s⇩1a: "s⇩1 = (ha, la, sha)" and e': "e' = THROW OutOfMemory"
and s': "s' = (h', l', sh')" and "∀sfs. sha C ≠ ⌊(sfs, Done)⌋"
and init': "P ⊢ ⟨INIT C ([C],False) ← unit,(ha, la, sha)⟩ ⇒ ⟨Val v',(h', l', sh')⟩"
and addr: "new_Addr h' = None"
then have i: "i = Processing" using iDP shC s⇩1 by simp
then have "(h', l', sh') = (ha, la, sha)" using init' init_ProcessingE s⇩1 s⇩1a shC by blast
then show ?thesis
using NewInitOOM NewInitRed.hyps e' addr s' s⇩1a init by auto
next
fix sha ha la a
assume s⇩1a: "s⇩1 = (ha, la, sha)"
and "∀sfs. sha C ≠ ⌊(sfs, Done)⌋"
and init': "P ⊢ ⟨INIT C ([C],False) ← unit,(ha, la, sha)⟩ ⇒ ⟨throw a,s'⟩"
then have i: "i = Processing" using iDP shC s⇩1 by simp
then show ?thesis using init' init_ProcessingE s⇩1 s⇩1a shC by blast
qed
next
fix e assume e': "e' = throw e"
and init: "P ⊢ ⟨INIT C ([C],False) ← unit,(h, l, sh)⟩ ⇒ ⟨throw e,s'⟩"
obtain h' l' sh' where s': "s' = (h',l',sh')" by(cases s')
then obtain sfs i where shC: "sh' C = ⌊(sfs, i)⌋" and iDP: "i = Error"
using init_throw_PD[OF init] by auto
then show ?thesis by (simp add: NewInitRed.hyps NewInitThrow e' init)
qed
next
case CastRed then show ?case
by(fastforce elim!: eval_cases intro: eval_evals.intros intro!: CastFail)
next
case RedCastNull
then show ?case
by simp (iprover elim: eval_cases intro: eval_evals.intros)
next
case RedCast
then show ?case
by (auto elim: eval_cases intro: eval_evals.intros)
next
case RedCastFail
then show ?case
by (auto elim!: eval_cases intro: eval_evals.intros)
next
case BinOpRed1 then show ?case
by(fastforce elim!: eval_cases intro: eval_evals.intros simp: val_no_step)
next
case BinOpRed2
thus ?case
by (fastforce elim!: eval_cases intro: eval_evals.intros eval_finalId)
next
case RedBinOp
thus ?case
by simp (iprover elim: eval_cases intro: eval_evals.intros)
next
case RedVar
thus ?case
by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case LAssRed thus ?case
by(fastforce elim: eval_cases intro: eval_evals.intros)
next
case RedLAss
thus ?case
by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case FAccRed thus ?case
by(fastforce elim: eval_cases intro: eval_evals.intros)
next
case RedFAcc then show ?case
by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case RedFAccNull then show ?case
by (fastforce elim!: eval_cases intro: eval_evals.intros)
next
case RedFAccNone thus ?case
by(fastforce elim: eval_cases intro: eval_evals.intros)
next
case RedFAccStatic thus ?case
by(fastforce elim: eval_cases intro: eval_evals.intros)
next
case (RedSFAcc C F t D sh sfs i v h l)
then have e':"e' = Val v" and s':"s' = (h, l, sh)"
using eval_cases(3) by fastforce+
have "i = Done ∨ i = Processing" using RedSFAcc by (clarsimp simp: bconf_def initPD_def)
then show ?case
proof(cases i)
case Done then show ?thesis using RedSFAcc e' s' SFAcc by simp
next
case Processing
then have shC': "∄sfs. sh D = Some(sfs,Done)" and shP: "sh D = Some(sfs,Processing)"
using RedSFAcc by simp+
then have init: "P ⊢ ⟨INIT D ([D],False) ← unit,(h,l,sh)⟩ ⇒ ⟨unit,(h,l,sh)⟩"
by(simp add: InitFinal InitProcessing Val)
have "P ⊢ ⟨C∙⇩sF{D},(h, l, sh)⟩ ⇒ ⟨Val v,(h,l,sh)⟩"
by(rule SFAccInit[OF RedSFAcc.hyps(1) shC' init shP RedSFAcc.hyps(3)])
then show ?thesis using e' s' by simp
qed(auto)
next
case (SFAccInitRed C F t D sh h l)
then have seq: "P ⊢ ⟨(INIT D ([D],False) ← unit);; C∙⇩sF{D},(h, l, sh)⟩ ⇒ ⟨e',s'⟩"
using eval_init_seq by simp
then show ?case
proof(rule eval_cases(14))
fix v s⇩1 assume init: "P ⊢ ⟨INIT D ([D],False) ← unit,(h, l, sh)⟩ ⇒ ⟨Val v,s⇩1⟩"
and acc: "P ⊢ ⟨C∙⇩sF{D},s⇩1⟩ ⇒ ⟨e',s'⟩"
obtain h⇩1 l⇩1 sh⇩1 where s⇩1: "s⇩1 = (h⇩1,l⇩1,sh⇩1)" by(cases s⇩1)
then obtain sfs i where shD: "sh⇩1 D = ⌊(sfs, i)⌋" and iDP: "i = Done ∨ i = Processing"
using init_Val_PD[OF init] by auto
show ?thesis
proof(rule eval_cases(8)[OF acc])
fix t sha sfs v ha la
assume "s⇩1 = (ha, la, sha)" and "e' = Val v"
and "s' = (ha, la, sha)" and "P ⊢ C has F,Static:t in D"
and "sha D = ⌊(sfs, Done)⌋" and "sfs F = ⌊v⌋"
then show ?thesis using SFAccInit SFAccInitRed.hyps(2) init by auto
next
fix t sha ha la v' h' l' sh' sfs i' v
assume s⇩1a: "s⇩1 = (ha, la, sha)" and e': "e' = Val v"
and s': "s' = (h', l', sh')" and field: "P ⊢ C has F,Static:t in D"
and "∀sfs. sha D ≠ ⌊(sfs, Done)⌋"
and init': "P ⊢ ⟨INIT D ([D],False) ← unit,(ha, la, sha)⟩ ⇒ ⟨Val v',(h', l', sh')⟩"
and shD': "sh' D = ⌊(sfs, i')⌋" and sfsF: "sfs F = ⌊v⌋"
then have i: "i = Processing" using iDP shD s⇩1 by simp
then have "(h', l', sh') = (ha, la, sha)" using init' init_ProcessingE s⇩1 s⇩1a shD by blast
then show ?thesis using SFAccInit SFAccInitRed.hyps(2) e' s' field init s⇩1a sfsF shD' by auto
next
fix t sha ha la a
assume s⇩1a: "s⇩1 = (ha, la, sha)" and "e' = throw a"
and "P ⊢ C has F,Static:t in D" and "∀sfs. sha D ≠ ⌊(sfs, Done)⌋"
and init': "P ⊢ ⟨INIT D ([D],False) ← unit,(ha, la, sha)⟩ ⇒ ⟨throw a,s'⟩"
then have i: "i = Processing" using iDP shD s⇩1 by simp
then show ?thesis using init' init_ProcessingE s⇩1 s⇩1a shD by blast
next
assume "∀b t. ¬ P ⊢ C has F,b:t in D"
then show ?thesis using SFAccInitRed.hyps(1) by blast
next
fix t assume field: "P ⊢ C has F,NonStatic:t in D"
then show ?thesis using has_field_fun[OF SFAccInitRed.hyps(1) field] by simp
qed
next
fix e assume e': "e' = throw e"
and init: "P ⊢ ⟨INIT D ([D],False) ← unit,(h, l, sh)⟩ ⇒ ⟨throw e,s'⟩"
obtain h' l' sh' where s': "s' = (h',l',sh')" by(cases s')
then obtain sfs i where shC: "sh' D = ⌊(sfs, i)⌋" and iDP: "i = Error"
using init_throw_PD[OF init] by auto
then show ?thesis
using SFAccInitRed.hyps(1) SFAccInitRed.hyps(2) SFAccInitThrow e' init by auto
qed
next
case RedSFAccNone thus ?case
by(fastforce elim: eval_cases intro: eval_evals.intros)
next
case RedSFAccNonStatic thus ?case
by(fastforce elim: eval_cases intro: eval_evals.intros)
next
case (FAssRed1 e s b e1 s1 b1 F D e⇩2)
obtain h' l' sh' where "s'=(h',l',sh')" by(cases s')
with FAssRed1 show ?case
by(fastforce elim!: eval_cases(9)[where e⇩1=e1] intro: eval_evals.intros simp: val_no_step
intro!: FAss FAssNull FAssNone FAssStatic FAssThrow2)
next
case FAssRed2
obtain h' l' sh' where "s'=(h',l',sh')" by(cases s')
with FAssRed2 show ?case
by(auto elim!: eval_cases intro: eval_evals.intros
intro!: FAss FAssNull FAssNone FAssStatic FAssThrow2 Val)
next
case RedFAss
thus ?case
by (fastforce elim!: eval_cases intro: eval_evals.intros)
next
case RedFAssNull
thus ?case
by (fastforce elim!: eval_cases intro: eval_evals.intros)
next
case RedFAssNone
then show ?case
by(auto elim!: eval_cases intro: eval_evals.intros eval_finalId)
next
case RedFAssStatic
then show ?case
by(auto elim!: eval_cases intro: eval_evals.intros eval_finalId)
next
case (SFAssRed e s b e'' s'' b'' C F D)
obtain h l sh where [simp]: "s = (h,l,sh)" by(cases s)
obtain h' l' sh' where [simp]: "s'=(h',l',sh')" by(cases s')
have "val_of e = None" using val_no_step SFAssRed.hyps(1) by(meson option.exhaust)
then have bconf: "P,sh ⊢⇩b (e,b) √" using SFAssRed by simp
show ?case using SFAssRed.prems(2) SFAssRed bconf
proof cases
case 2 with SFAssRed bconf show ?thesis by(auto intro!: SFAssInit)
next
case 3 with SFAssRed bconf show ?thesis by(auto intro!: SFAssInitThrow)
qed(auto intro: eval_evals.intros intro!: SFAss SFAssInit SFAssNone SFAssNonStatic)
next
case (RedSFAss C F t D sh sfs i sfs' v sh' h l)
let ?sfs' = "sfs(F ↦ v)"
have e':"e' = unit" and s':"s' = (h, l, sh(D ↦ (?sfs', i)))"
using RedSFAss eval_cases(3) by fastforce+
have "i = Done ∨ i = Processing" using RedSFAss by(clarsimp simp: bconf_def initPD_def)
then show ?case
proof(cases i)
case Done then show ?thesis using RedSFAss e' s' SFAss Val by auto
next
case Processing
then have shC': "∄sfs. sh D = Some(sfs,Done)" and shP: "sh D = Some(sfs,Processing)"
using RedSFAss by simp+
then have init: "P ⊢ ⟨INIT D ([D],False) ← unit,(h,l,sh)⟩ ⇒ ⟨unit,(h,l,sh)⟩"
by(simp add: InitFinal InitProcessing Val)
have "P ⊢ ⟨C∙⇩sF{D} := Val v,(h, l, sh)⟩ ⇒ ⟨unit,(h,l,sh(D ↦ (?sfs', i)))⟩"
using Processing by(auto intro: SFAssInit[OF Val RedSFAss.hyps(1) shC' init shP])
then show ?thesis using e' s' by simp
qed(auto)
next
case (SFAssInitRed C F t D sh v h l)
then have seq: "P ⊢ ⟨(INIT D ([D],False) ← unit);; C∙⇩sF{D} := Val v,(h, l, sh)⟩ ⇒ ⟨e',s'⟩"
using eval_init_seq by simp
then show ?case
proof(rule eval_cases(14))
fix v' s⇩1 assume init: "P ⊢ ⟨INIT D ([D],False) ← unit,(h, l, sh)⟩ ⇒ ⟨Val v',s⇩1⟩"
and acc: "P ⊢ ⟨C∙⇩sF{D} := Val v,s⇩1⟩ ⇒ ⟨e',s'⟩"
obtain h⇩1 l⇩1 sh⇩1 where s⇩1: "s⇩1 = (h⇩1,l⇩1,sh⇩1)" by(cases s⇩1)
then obtain sfs i where shD: "sh⇩1 D = ⌊(sfs, i)⌋" and iDP: "i = Done ∨ i = Processing"
using init_Val_PD[OF init] by auto
show ?thesis
proof(rule eval_cases(10)[OF acc])
fix va h⇩1 l⇩1 sh⇩1 t sfs
assume e': "e' = unit" and s': "s' = (h⇩1, l⇩1, sh⇩1(D ↦ (sfs(F ↦ va), Done)))"
and val: "P ⊢ ⟨Val v,s⇩1⟩ ⇒ ⟨Val va,(h⇩1, l⇩1, sh⇩1)⟩"
and field: "P ⊢ C has F,Static:t in D" and shD': "sh⇩1 D = ⌊(sfs, Done)⌋"
have "v = va" and "s⇩1 = (h⇩1, l⇩1, sh⇩1)" using eval_final_same[OF val] by auto
then show ?thesis using SFAssInit field SFAssInitRed.hyps(2) shD' e' s' init val
by (metis eval_final eval_finalId)
next
fix va h⇩1 l⇩1 sh⇩1 t v' h' l' sh' sfs i'
assume e': "e' = unit" and s': "s' = (h', l', sh'(D ↦ (sfs(F ↦ va), i')))"
and val: "P ⊢ ⟨Val v,s⇩1⟩ ⇒ ⟨Val va,(h⇩1, l⇩1, sh⇩1)⟩"
and field: "P ⊢ C has F,Static:t in D" and nDone: "∀sfs. sh⇩1 D ≠ ⌊(sfs, Done)⌋"
and init': "P ⊢ ⟨INIT D ([D],False) ← unit,(h⇩1, l⇩1, sh⇩1)⟩ ⇒ ⟨Val v',(h', l', sh')⟩"
and shD': "sh' D = ⌊(sfs, i')⌋"
have v: "v = va" and s⇩1a: "s⇩1 = (h⇩1, l⇩1, sh⇩1)" using eval_final_same[OF val] by auto
then have i: "i = Processing" using iDP shD s⇩1 nDone by simp
then have "(h⇩1, l⇩1, sh⇩1) = (h', l', sh')" using init' init_ProcessingE s⇩1 s⇩1a shD by blast
then show ?thesis using SFAssInit SFAssInitRed.hyps(2) e' s' field init v s⇩1a shD' val
by (metis eval_final eval_finalId)
next
fix va h⇩1 l⇩1 sh⇩1 t a
assume "e' = throw a" and val: "P ⊢ ⟨Val v,s⇩1⟩ ⇒ ⟨Val va,(h⇩1, l⇩1, sh⇩1)⟩"
and "P ⊢ C has F,Static:t in D" and nDone: "∀sfs. sh⇩1 D ≠ ⌊(sfs, Done)⌋"
and init': "P ⊢ ⟨INIT D ([D],False) ← unit,(h⇩1, l⇩1, sh⇩1)⟩ ⇒ ⟨throw a,s'⟩"
have v: "v = va" and s⇩1a: "s⇩1 = (h⇩1, l⇩1, sh⇩1)" using eval_final_same[OF val] by auto
then have i: "i = Processing" using iDP shD s⇩1 nDone by simp
then have "(h⇩1, l⇩1, sh⇩1) = s'" using init' init_ProcessingE s⇩1 s⇩1a shD by blast
then show ?thesis using init' init_ProcessingE s⇩1 s⇩1a shD i by blast
next
fix e'' assume val:"P ⊢ ⟨Val v,s⇩1⟩ ⇒ ⟨throw e'',s'⟩"
then show ?thesis using eval_final_same[OF val] by simp
next
assume "∀b t. ¬ P ⊢ C has F,b:t in D"
then show ?thesis using SFAssInitRed.hyps(1) by blast
next
fix t assume field: "P ⊢ C has F,NonStatic:t in D"
then show ?thesis using has_field_fun[OF SFAssInitRed.hyps(1) field] by simp
qed
next
fix e assume e': "e' = throw e"
and init: "P ⊢ ⟨INIT D ([D],False) ← unit,(h, l, sh)⟩ ⇒ ⟨throw e,s'⟩"
obtain h' l' sh' where s': "s' = (h',l',sh')" by(cases s')
then obtain sfs i where shC: "sh' D = ⌊(sfs, i)⌋" and iDP: "i = Error"
using init_throw_PD[OF init] by auto
then show ?thesis using SFAssInitRed.hyps(1) SFAssInitRed.hyps(2) SFAssInitThrow Val
by (metis e' init)
qed
next
case (RedSFAssNone C F D v s b) then show ?case
by(cases s) (auto elim!: eval_cases intro: eval_evals.intros eval_finalId)
next
case (RedSFAssNonStatic C F t D v s b) then show ?case
by(cases s) (auto elim!: eval_cases intro: eval_evals.intros eval_finalId)
next
case CallObj
note val_no_step[simp]
from CallObj.prems(2) CallObj show ?case
proof cases
case 2 with CallObj show ?thesis by(fastforce intro!: CallParamsThrow)
next
case 3 with CallObj show ?thesis by(fastforce intro!: CallNull)
next
case 4 with CallObj show ?thesis by(fastforce intro!: CallNone)
next
case 5 with CallObj show ?thesis by(fastforce intro!: CallStatic)
qed(fastforce intro!: CallObjThrow Call)+
next
case (CallParams es s b es'' s'' b'' v M s')
then obtain h' l' sh' where "s' = (h',l',sh')" by(cases s')
with CallParams show ?case
by(auto elim!: eval_cases intro!: CallNone eval_finalId CallStatic Val)
(auto intro!: CallParamsThrow CallNull Call Val)
next
case (RedCall h a C fs M Ts T pns body D vs l sh b)
have "P ⊢ ⟨addr a,(h,l,sh)⟩ ⇒ ⟨addr a,(h,l,sh)⟩" by (rule eval_evals.intros)
moreover
have finals: "finals(map Val vs)" by simp
with finals have "P ⊢ ⟨map Val vs,(h,l,sh)⟩ [⇒] ⟨map Val vs,(h,l,sh)⟩"
by (iprover intro: eval_finalsId)
moreover have "h a = Some (C, fs)" using RedCall by simp
moreover have "method": "P ⊢ C sees M,NonStatic: Ts→T = (pns, body) in D" by fact
moreover have same_len⇩1: "length Ts = length pns"
and this_distinct: "this ∉ set pns" and fv: "fv (body) ⊆ {this} ∪ set pns"
using "method" wf by (fastforce dest!:sees_wf_mdecl simp:wf_mdecl_def)+
have same_len: "length vs = length pns" by fact
moreover
obtain l⇩2' where l⇩2': "l⇩2' = [this↦Addr a,pns[↦]vs]" by simp
moreover
obtain h⇩3 l⇩3 sh⇩3 where s': "s' = (h⇩3,l⇩3,sh⇩3)" by (cases s')
have eval_blocks:
"P ⊢ ⟨(blocks (this # pns, Class D # Ts, Addr a # vs, body)),(h,l,sh)⟩ ⇒ ⟨e',s'⟩" by fact
hence id: "l⇩3 = l" using fv s' same_len⇩1 same_len
by(fastforce elim: eval_closed_lcl_unchanged)
from eval_blocks obtain l⇩3' where "P ⊢ ⟨body,(h,l⇩2',sh)⟩ ⇒ ⟨e',(h⇩3,l⇩3',sh⇩3)⟩"
proof -
from same_len⇩1 have "length(this#pns) = length(Class D#Ts)" by simp
moreover from same_len⇩1 same_len
have same_len⇩2: "length (this#pns) = length (Addr a#vs)" by simp
moreover from eval_blocks
have "P ⊢ ⟨blocks (this#pns,Class D#Ts,Addr a#vs,body),(h,l,sh)⟩
⇒⟨e',(h⇩3,l⇩3,sh⇩3)⟩" using s' same_len⇩1 same_len⇩2 by simp
ultimately obtain l''
where "P ⊢ ⟨body,(h,l(this # pns[↦]Addr a # vs),sh)⟩⇒⟨e',(h⇩3, l'',sh⇩3)⟩"
by (blast dest:blocksEval)
from eval_restrict_lcl[OF wf this fv] this_distinct same_len⇩1 same_len
have "P ⊢ ⟨body,(h,[this # pns[↦]Addr a # vs],sh)⟩ ⇒
⟨e',(h⇩3, l''|`(set(this#pns)),sh⇩3)⟩" using wf method
by(simp add:subset_insert_iff insert_Diff_if)
thus ?thesis by(fastforce intro!:that simp add: l⇩2')
qed
ultimately
have "P ⊢ ⟨(addr a)∙M(map Val vs),(h,l,sh)⟩ ⇒ ⟨e',(h⇩3,l,sh⇩3)⟩" by (rule Call)
with s' id show ?case by simp
next
case RedCallNull
thus ?case
by (fastforce elim: eval_cases intro: eval_evals.intros eval_finalsId)
next
case (RedCallNone h a C fs M vs l sh b)
then have tes: "THROW NoSuchMethodError = e' ∧ (h,l,sh) = s'"
using eval_final_same by simp
have "P ⊢ ⟨addr a,(h,l,sh)⟩ ⇒ ⟨addr a,(h,l,sh)⟩" and "P ⊢ ⟨map Val vs,(h,l,sh)⟩ [⇒] ⟨map Val vs,(h,l,sh)⟩"
using eval_finalId eval_finalsId by auto
then show ?case using RedCallNone CallNone tes by auto
next
case (RedCallStatic h a C fs M Ts T m D vs l sh b)
then have tes: "THROW IncompatibleClassChangeError = e' ∧ (h,l,sh) = s'"
using eval_final_same by simp
have "P ⊢ ⟨addr a,(h,l,sh)⟩ ⇒ ⟨addr a,(h,l,sh)⟩" and "P ⊢ ⟨map Val vs,(h,l,sh)⟩ [⇒] ⟨map Val vs,(h,l,sh)⟩"
using eval_finalId eval_finalsId by auto
then show ?case using RedCallStatic CallStatic tes by fastforce
next
case (SCallParams es s b es'' s'' b' C M s')
obtain h' l' sh' where s'[simp]: "s' = (h',l',sh')" by(cases s')
obtain h l sh where s[simp]: "s = (h,l,sh)" by(cases s)
have es: "map_vals_of es = None" using vals_no_step SCallParams.hyps(1) by (meson not_Some_eq)
have bconf: "P,sh ⊢⇩b (es,b) √" using s SCallParams.prems(1) by (simp add: bconf_SCall[OF es])
from SCallParams.prems(2) SCallParams bconf show ?case
proof cases
case 2 with SCallParams bconf show ?thesis by(auto intro!: SCallNone)
next
case 3 with SCallParams bconf show ?thesis by(auto intro!: SCallNonStatic)
next
case 4 with SCallParams bconf show ?thesis by(auto intro!: SCallInitThrow)
next
case 5 with SCallParams bconf show ?thesis by(auto intro!: SCallInit)
qed(auto intro!: SCallParamsThrow SCall)
next
case (RedSCall C M Ts T pns body D vs s)
then obtain h l sh where s:"s = (h,l,sh)" by(cases s)
then obtain sfs i where shC: "sh D = ⌊(sfs, i)⌋" and "i = Done ∨ i = Processing"
using RedSCall by(auto simp: bconf_def initPD_def dest: sees_method_fun)
have finals: "finals(map Val vs)" by simp
with finals have mVs: "P ⊢ ⟨map Val vs,(h,l,sh)⟩ [⇒] ⟨map Val vs,(h,l,sh)⟩"
by (iprover intro: eval_finalsId)
obtain sfs i where shC: "sh D = ⌊(sfs, i)⌋"
using RedSCall s by(auto simp: bconf_def initPD_def dest: sees_method_fun)
then have iDP: "i = Done ∨ i = Processing" using RedSCall s
by (auto simp: bconf_def initPD_def dest: sees_method_fun[OF RedSCall.hyps(1)])
have "method": "P ⊢ C sees M,Static: Ts→T = (pns, body) in D" by fact
have same_len⇩1: "length Ts = length pns" and fv: "fv (body) ⊆ set pns"
using "method" wf by (fastforce dest!:sees_wf_mdecl simp:wf_mdecl_def)+
have same_len: "length vs = length pns" by fact
obtain l⇩2' where l⇩2': "l⇩2' = [pns[↦]vs]" by simp
obtain h⇩3 l⇩3 sh⇩3 where s': "s' = (h⇩3,l⇩3,sh⇩3)" by (cases s')
have eval_blocks:
"P ⊢ ⟨(blocks (pns, Ts, vs, body)),(h,l,sh)⟩ ⇒ ⟨e',s'⟩" using RedSCall.prems(2) s by simp
hence id: "l⇩3 = l" using fv s' same_len⇩1 same_len
by(fastforce elim: eval_closed_lcl_unchanged)
from eval_blocks obtain l⇩3' where body: "P ⊢ ⟨body,(h,l⇩2',sh)⟩ ⇒ ⟨e',(h⇩3,l⇩3',sh⇩3)⟩"
proof -
from eval_blocks
have "P ⊢ ⟨blocks (pns,Ts,vs,body),(h,l,sh)⟩
⇒⟨e',(h⇩3,l⇩3,sh⇩3)⟩" using s' same_len same_len⇩1 by simp
then obtain l''
where "P ⊢ ⟨body,(h,l(pns[↦]vs),sh)⟩ ⇒ ⟨e',(h⇩3, l'',sh⇩3)⟩"
by (blast dest:blocksEval[OF same_len⇩1[THEN sym] same_len[THEN sym]])
from eval_restrict_lcl[OF wf this fv] same_len⇩1 same_len
have "P ⊢ ⟨body,(h,[pns[↦]vs],sh)⟩ ⇒ ⟨e',(h⇩3, l''|`(set(pns)),sh⇩3)⟩" using wf method
by(simp add:subset_insert_iff insert_Diff_if)
thus ?thesis by(fastforce intro!:that simp add: l⇩2')
qed
show ?case using iDP
proof(cases i)
case Done
then have shC': "sh D = ⌊(sfs, Done)⌋ ∨ M = clinit ∧ sh D = ⌊(sfs, Processing)⌋"
using shC by simp
have "P ⊢ ⟨C∙⇩sM(map Val vs),(h,l,sh)⟩ ⇒ ⟨e',(h⇩3,l,sh⇩3)⟩"
by (rule SCall[OF mVs method shC' same_len l⇩2' body])
with s s' id show ?thesis by simp
next
case Processing
then have shC': "∄sfs. sh D = Some(sfs,Done)" and shP: "sh D = Some(sfs,Processing)"
using shC by simp+
then have init: "P ⊢ ⟨INIT D ([D],False) ← unit,(h,l,sh)⟩ ⇒ ⟨unit,(h,l,sh)⟩"
by(simp add: InitFinal InitProcessing Val)
have "P ⊢ ⟨C∙⇩sM(map Val vs),(h,l,sh)⟩ ⇒ ⟨e',(h⇩3,l,sh⇩3)⟩"
proof(cases "M = clinit")
case False show ?thesis by(rule SCallInit[OF mVs method shC' False init same_len l⇩2' body])
next
case True
then have shC': "sh D = ⌊(sfs, Done)⌋ ∨ M = clinit ∧ sh D = ⌊(sfs, Processing)⌋"
using shC Processing by simp
have "P ⊢ ⟨C∙⇩sM(map Val vs),(h,l,sh)⟩ ⇒ ⟨e',(h⇩3,l,sh⇩3)⟩"
by (rule SCall[OF mVs method shC' same_len l⇩2' body])
with s s' id show ?thesis by simp
qed
with s s' id show ?thesis by simp
qed(auto)
next
case (SCallInitRed C M Ts T pns body D sh vs h l)
then have seq: "P ⊢ ⟨(INIT D ([D],False) ← unit);; C∙⇩sM(map Val vs),(h, l, sh)⟩ ⇒ ⟨e',s'⟩"
using eval_init_seq by simp
then show ?case
proof(rule eval_cases(14))
fix v' s⇩1 assume init: "P ⊢ ⟨INIT D ([D],False) ← unit,(h, l, sh)⟩ ⇒ ⟨Val v',s⇩1⟩"
and call: "P ⊢ ⟨C∙⇩sM(map Val vs),s⇩1⟩ ⇒ ⟨e',s'⟩"
obtain h⇩1 l⇩1 sh⇩1 where s⇩1: "s⇩1 = (h⇩1,l⇩1,sh⇩1)" by(cases s⇩1)
then obtain sfs i where shD: "sh⇩1 D = ⌊(sfs, i)⌋" and iDP: "i = Done ∨ i = Processing"
using init_Val_PD[OF init] by auto
show ?thesis
proof(rule eval_cases(12)[OF call])
fix vsa ex es' assume "P ⊢ ⟨map Val vs,s⇩1⟩ [⇒] ⟨map Val vsa @ throw ex # es',s'⟩"
then show ?thesis using evals_finals_same by (meson finals_def map_Val_nthrow_neq)
next
assume "∀b Ts T a ba x. ¬ P ⊢ C sees M, b : Ts→T = (a, ba) in x"
then show ?thesis using SCallInitRed.hyps(1) by auto
next
fix Ts T m D assume "P ⊢ C sees M, NonStatic : Ts→T = m in D"
then show ?thesis using sees_method_fun[OF SCallInitRed.hyps(1)] by blast
next
fix vsa h1 l1 sh1 Ts T pns body D' a
assume "e' = throw a" and vals: "P ⊢ ⟨map Val vs,s⇩1⟩ [⇒] ⟨map Val vsa,(h1, l1, sh1)⟩"
and method: "P ⊢ C sees M, Static : Ts→T = (pns, body) in D'"
and nDone: "∀sfs. sh1 D' ≠ ⌊(sfs, Done)⌋"
and init': "P ⊢ ⟨INIT D' ([D'],False) ← unit,(h1, l1, sh1)⟩ ⇒ ⟨throw a,s'⟩"
have vs: "vs = vsa" and s⇩1a: "s⇩1 = (h1, l1, sh1)"
using evals_finals_same[OF _ vals] map_Val_eq by auto
have D: "D = D'" using sees_method_fun[OF SCallInitRed.hyps(1) method] by simp
then have i: "i = Processing" using iDP shD s⇩1 s⇩1a nDone by simp
then show ?thesis using D init' init_ProcessingE s⇩1 s⇩1a shD by blast
next
fix vsa h1 l1 sh1 Ts T pns' body' D' v' h⇩2 l⇩2 sh⇩2 h⇩3 l⇩3 sh⇩3
assume s': "s' = (h⇩3, l⇩2, sh⇩3)"
and vals: "P ⊢ ⟨map Val vs,s⇩1⟩ [⇒] ⟨map Val vsa,(h1, l1, sh1)⟩"
and method: "P ⊢ C sees M, Static : Ts→T = (pns', body') in D'"
and nDone: "∀sfs. sh1 D' ≠ ⌊(sfs, Done)⌋"
and init': "P ⊢ ⟨INIT D' ([D'],False) ← unit,(h1, l1, sh1)⟩ ⇒ ⟨Val v',(h⇩2, l⇩2, sh⇩2)⟩"
and len: "length vsa = length pns'"
and bstep: "P ⊢ ⟨body',(h⇩2, [pns' [↦] vsa], sh⇩2)⟩ ⇒ ⟨e',(h⇩3, l⇩3, sh⇩3)⟩"
have vs: "vs = vsa" and s⇩1a: "s⇩1 = (h1, l1, sh1)"
using evals_finals_same[OF _ vals] map_Val_eq by auto
have D: "D = D'" and pns: "pns = pns'" and body: "body = body'"
using sees_method_fun[OF SCallInitRed.hyps(1) method] by auto
then have i: "i = Processing" using iDP shD s⇩1 s⇩1a nDone by simp
then have s2: "(h⇩2, l⇩2, sh⇩2) = s⇩1" using D init' init_ProcessingE s⇩1 s⇩1a shD by blast
then show ?thesis
using eval_finalId SCallInit[OF eval_finalsId[of "map Val vs" P "(h,l,sh)"]
SCallInitRed.hyps(1)] init init' len bstep nDone D pns body s' s⇩1 s⇩1a shD vals vs
SCallInitRed.hyps(2-3) s2 by auto
next
fix vsa h⇩2 l⇩2 sh⇩2 Ts T pns' body' D' sfs h⇩3 l⇩3 sh⇩3
assume s': "s' = (h⇩3, l⇩2, sh⇩3)" and vals: "P ⊢ ⟨map Val vs,s⇩1⟩ [⇒] ⟨map Val vsa,(h⇩2, l⇩2, sh⇩2)⟩"
and method: "P ⊢ C sees M, Static : Ts→T = (pns', body') in D'"
and "sh⇩2 D' = ⌊(sfs, Done)⌋ ∨ M = clinit ∧ sh⇩2 D' = ⌊(sfs, Processing)⌋"
and len: "length vsa = length pns'"
and bstep: "P ⊢ ⟨body',(h⇩2, [pns' [↦] vsa], sh⇩2)⟩ ⇒ ⟨e',(h⇩3, l⇩3, sh⇩3)⟩"
have vs: "vs = vsa" and s⇩1a: "s⇩1 = (h⇩2, l⇩2, sh⇩2)"
using evals_finals_same[OF _ vals] map_Val_eq by auto
have D: "D = D'" and pns: "pns = pns'" and body: "body = body'"
using sees_method_fun[OF SCallInitRed.hyps(1) method] by auto
then show ?thesis using SCallInit[OF eval_finalsId[of "map Val vs" P "(h,l,sh)"]
SCallInitRed.hyps(1)] bstep SCallInitRed.hyps(2-3) len s' s⇩1a vals vs init by auto
qed
next
fix e assume e': "e' = throw e"
and init: "P ⊢ ⟨INIT D ([D],False) ← unit,(h, l, sh)⟩ ⇒ ⟨throw e,s'⟩"
obtain h' l' sh' where s': "s' = (h',l',sh')" by(cases s')
then obtain sfs i where shC: "sh' D = ⌊(sfs, i)⌋" and iDP: "i = Error"
using init_throw_PD[OF init] by auto
then show ?thesis using SCallInitRed.hyps(2-3) init e'
SCallInitThrow[OF eval_finalsId[of "map Val vs" _] SCallInitRed.hyps(1)]
by auto
qed
next
case (RedSCallNone C M vs s b)
then have tes: "THROW NoSuchMethodError = e' ∧ s = s'"
using eval_final_same by simp
have "P ⊢ ⟨map Val vs,s⟩ [⇒] ⟨map Val vs,s⟩" using eval_finalsId by simp
then show ?case using RedSCallNone eval_evals.SCallNone tes by auto
next
case (RedSCallNonStatic C M Ts T m D vs s b)
then have tes: "THROW IncompatibleClassChangeError = e' ∧ s = s'"
using eval_final_same by simp
have "P ⊢ ⟨map Val vs,s⟩ [⇒] ⟨map Val vs,s⟩" using eval_finalsId by simp
then show ?case using RedSCallNonStatic eval_evals.SCallNonStatic tes by auto
next
case InitBlockRed
thus ?case
by (fastforce elim!: eval_cases intro: eval_evals.intros eval_finalId
simp: assigned_def map_upd_triv fun_upd_same)
next
case (RedInitBlock V T v u s b)
then have "P ⊢ ⟨Val u,s⟩ ⇒ ⟨e',s'⟩" by simp
then obtain s': "s'=s" and e': "e'=Val u" by cases simp
obtain h l sh where s: "s=(h,l,sh)" by (cases s)
have "P ⊢ ⟨{V:T :=Val v; Val u},(h,l,sh)⟩ ⇒ ⟨Val u,(h, (l(V↦v))(V:=l V), sh)⟩"
by (fastforce intro!: eval_evals.intros)
then have "P ⊢ ⟨{V:T := Val v; Val u},s⟩ ⇒ ⟨e',s'⟩" using s s' e' by simp
then show ?case by simp
next
case BlockRedNone
thus ?case
by (fastforce elim!: eval_cases intro: eval_evals.intros
simp add: fun_upd_same fun_upd_idem)
next
case BlockRedSome
thus ?case
by (fastforce elim!: eval_cases intro: eval_evals.intros
simp add: fun_upd_same fun_upd_idem)
next
case (RedBlock V T v s b)
then have "P ⊢ ⟨Val v,s⟩ ⇒ ⟨e',s'⟩" by simp
then obtain s': "s'=s" and e': "e'=Val v"
by cases simp
obtain h l sh where s: "s=(h,l,sh)" by (cases s)
have "P ⊢ ⟨Val v,(h,l(V:=None),sh)⟩ ⇒ ⟨Val v,(h,l(V:=None),sh)⟩"
by (rule eval_evals.intros)
hence "P ⊢ ⟨{V:T;Val v},(h,l,sh)⟩ ⇒ ⟨Val v,(h,(l(V:=None))(V:=l V),sh)⟩"
by (rule eval_evals.Block)
then have "P ⊢ ⟨{V:T; Val v},s⟩ ⇒ ⟨e',s'⟩" using s s' e' by simp
then show ?case by simp
next
case (SeqRed e s b e1 s1 b1 e⇩2) show ?case
proof(cases "val_of e")
case None show ?thesis
proof(cases "lass_val_of e")
case lNone:None
then have bconf: "P,shp s ⊢⇩b (e,b) √" using SeqRed.prems(1) None by simp
then show ?thesis using SeqRed using seq_ext by fastforce
next
case (Some p)
obtain V' v' where p: "p = (V',v')" and e: "e = V':=Val v'"
using lass_val_of_spec[OF Some] by(cases p, auto)
obtain h l sh h' l' sh' where s: "s = (h,l,sh)" and s1: "s1 = (h',l',sh')" by(cases s, cases s1)
then have red: "P ⊢ ⟨e,(h,l,sh),b⟩ → ⟨e1,(h',l',sh'),b1⟩" using SeqRed.hyps(1) by simp
then have s⇩1': "e1 = unit ∧ h' = h ∧ l' = l(V' ↦ v') ∧ sh' = sh"
using lass_val_of_red[OF Some red] p e by simp
then have eval: "P ⊢ ⟨e,s⟩ ⇒ ⟨e1,s1⟩" using e s s1 LAss Val by auto
then show ?thesis
by (metis SeqRed.prems(2) eval_final eval_final_same seq_ext)
qed
next
case (Some a) then show ?thesis using SeqRed.hyps(1) val_no_step by blast
qed
next
case RedSeq
thus ?case
by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case CondRed
thus ?case
by (fastforce elim: eval_cases intro: eval_evals.intros simp: val_no_step)
next
case RedCondT
thus ?case
by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case RedCondF
thus ?case
by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case RedWhile
thus ?case
by (auto simp add: unfold_while intro:eval_evals.intros elim:eval_cases)
next
case ThrowRed then show ?case by(fastforce elim: eval_cases simp: eval_evals.intros)
next
case RedThrowNull
thus ?case
by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case TryRed thus ?case
by(fastforce elim: eval_cases intro: eval_evals.intros)
next
case RedTryCatch
thus ?case
by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case (RedTryFail s a D fs C V e⇩2 b)
thus ?case
by (cases s)(auto elim!: eval_cases intro: eval_evals.intros)
next
case ListRed1
thus ?case
by (fastforce elim: evals_cases intro: eval_evals.intros simp: val_no_step)
next
case ListRed2
thus ?case
by (fastforce elim!: evals_cases eval_cases
intro: eval_evals.intros eval_finalId)
next
case (RedInit e1 C b s1 b') then show ?case using InitFinal by simp
next
case (InitNoneRed sh C C' Cs e h l b)
show ?case using InitNone InitNoneRed.hyps InitNoneRed.prems(2) by auto
next
case (RedInitDone sh C sfs C' Cs e h l b)
show ?case using InitDone RedInitDone.hyps RedInitDone.prems(2) by auto
next
case (RedInitProcessing sh C sfs C' Cs e h l b)
show ?case using InitProcessing RedInitProcessing.hyps RedInitProcessing.prems(2) by auto
next
case (RedInitError sh C sfs C' Cs e h l b)
show ?case using InitError RedInitError.hyps RedInitError.prems(2) by auto
next
case (InitObjectRed sh C sfs sh' C' Cs e h l b) show ?case using InitObject InitObjectRed by auto
next
case (InitNonObjectSuperRed sh C sfs D r sh' C' Cs e h l b)
show ?case using InitNonObject InitNonObjectSuperRed by auto
next
case (RedInitRInit C' C Cs e h l sh b)
show ?case using InitRInit RedInitRInit by auto
next
case (RInitRed e s b e'' s'' b'' C Cs e⇩0)
then have IH: "⋀e' s'. P ⊢ ⟨e'',s''⟩ ⇒ ⟨e',s'⟩ ⟹ P ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩" by simp
show ?case using RInitRed rinit_ext[OF IH] by simp
next
case (RedRInit sh C sfs i sh' C' Cs v e h l b s' e')
then have init: "P ⊢ ⟨(INIT C' (Cs,True) ← e), (h, l, sh(C ↦ (sfs, Done)))⟩ ⇒ ⟨e',s'⟩"
using RedRInit by simp
then show ?case using RInit RedRInit.hyps(1) RedRInit.hyps(3) Val by fastforce
next
case BinOpThrow2
thus ?case
by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case FAssThrow2
thus ?case
by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case SFAssThrow
then show ?case
by (fastforce elim: eval_cases intro: eval_evals.intros)
next
case (CallThrowParams es vs e es' v M s b)
have val: "P ⊢ ⟨Val v,s⟩ ⇒ ⟨Val v,s⟩" by (rule eval_evals.intros)
have eval_e: "P ⊢ ⟨throw (e),s⟩ ⇒ ⟨e',s'⟩" using CallThrowParams by simp
then obtain xa where e': "e' = Throw xa" by (cases) (auto dest!: eval_final)
with list_eval_Throw [OF eval_e]
have vals: "P ⊢ ⟨es,s⟩ [⇒] ⟨map Val vs @ Throw xa # es',s'⟩"
using CallThrowParams.hyps(1) eval_e list_eval_Throw by blast
then have "P ⊢ ⟨Val v∙M(es),s⟩ ⇒ ⟨Throw xa,s'⟩"
using eval_evals.CallParamsThrow[OF val vals] by simp
thus ?case using e' by simp
next
case (SCallThrowParams es vs e es' C M s b)
have eval_e: "P ⊢ ⟨throw (e),s⟩ ⇒ ⟨e',s'⟩" using SCallThrowParams by simp
then obtain xa where e': "e' = Throw xa" by (cases) (auto dest!: eval_final)
then have "P ⊢ ⟨es,s⟩ [⇒] ⟨map Val vs @ Throw xa # es',s'⟩"
using SCallThrowParams.hyps(1) eval_e list_eval_Throw by blast
then have "P ⊢ ⟨C∙⇩sM(es),s⟩ ⇒ ⟨Throw xa,s'⟩"
by (rule eval_evals.SCallParamsThrow)
thus ?case using e' by simp
next
case (BlockThrow V T a s b)
then have "P ⊢ ⟨Throw a, s⟩ ⇒ ⟨e',s'⟩" by simp
then obtain s': "s' = s" and e': "e' = Throw a"
by cases (auto elim!:eval_cases)
obtain h l sh where s: "s=(h,l,sh)" by (cases s)
have "P ⊢ ⟨Throw a, (h,l(V:=None),sh)⟩ ⇒ ⟨Throw a, (h,l(V:=None),sh)⟩"
by (simp add:eval_evals.intros eval_finalId)
hence "P⊢⟨{V:T;Throw a},(h,l,sh)⟩ ⇒ ⟨Throw a, (h,(l(V:=None))(V:=l V),sh)⟩"
by (rule eval_evals.Block)
then have "P ⊢ ⟨{V:T; Throw a},s⟩ ⇒ ⟨e',s'⟩" using s s' e' by simp
then show ?case by simp
next
case (InitBlockThrow V T v a s b)
then have "P ⊢ ⟨Throw a,s⟩ ⇒ ⟨e',s'⟩" by simp
then obtain s': "s' = s" and e': "e' = Throw a"
by cases (auto elim!:eval_cases)
obtain h l sh where s: "s = (h,l,sh)" by (cases s)
have "P ⊢ ⟨{V:T :=Val v; Throw a},(h,l,sh)⟩ ⇒ ⟨Throw a, (h, (l(V↦v))(V:=l V),sh)⟩"
by(fastforce intro:eval_evals.intros)
then have "P ⊢ ⟨{V:T := Val v; Throw a},s⟩ ⇒ ⟨e',s'⟩" using s s' e' by simp
then show ?case by simp
next
case (RInitInitThrow sh C sfs i sh' a D Cs e h l b)
have IH: "⋀e' s'. P ⊢ ⟨RI (D,Throw a) ; Cs ← e,(h, l, sh(C ↦ (sfs, Error)))⟩ ⇒ ⟨e',s'⟩ ⟹
P ⊢ ⟨RI (C,Throw a) ; D # Cs ← e,(h, l, sh)⟩ ⇒ ⟨e',s'⟩"
using RInitInitFail[OF eval_finalId] RInitInitThrow by simp
then show ?case using RInitInitThrow.hyps(2) RInitInitThrow.prems(2) by auto
next
case (RInitThrow sh C sfs i sh' a e h l b)
then have e': "e' = Throw a" and s': "s' = (h,l,sh')"
using eval_final_same final_def by fastforce+
show ?case using RInitFailFinal RInitThrow.hyps(1) RInitThrow.hyps(2) e' eval_finalId s' by auto
qed(auto elim: eval_cases simp: eval_evals.intros)
declare split_paired_All [simp] split_paired_Ex [simp]
text ‹ Its extension to @{text"→*"}: ›
lemma extend_eval:
assumes wf: "wwf_J_prog P"
and reds: "P ⊢ ⟨e,s,b⟩ →* ⟨e'',s'',b''⟩" and eval_rest: "P ⊢ ⟨e'',s''⟩ ⇒ ⟨e',s'⟩"
and iconf: "iconf (shp s) e" and bconf: "P,shp s ⊢⇩b (e::expr,b) √"
shows "P ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩"
using reds eval_rest iconf bconf
proof (induct rule: converse_rtrancl_induct3)
case refl then show ?case by simp
next
case (step e1 s1 b1 e2 s2 b2)
then have ic: "iconf (shp s2) e2" using Red_preserves_iconf local.wf by blast
then have ec: "P,shp s2 ⊢⇩b (e2,b2) √"
using Red_preserves_bconf local.wf step.hyps(1) step.prems(2) step.prems(3) by blast
show ?case using step ic ec extend_1_eval[OF wf step.hyps(1)] by simp
qed
lemma extend_evals:
assumes wf: "wwf_J_prog P"
and reds: "P ⊢ ⟨es,s,b⟩ [→]* ⟨es'',s'',b''⟩" and eval_rest: "P ⊢ ⟨es'',s''⟩ [⇒] ⟨es',s'⟩"
and iconf: "iconfs (shp s) es" and bconf: "P,shp s ⊢⇩b (es::expr list,b) √"
shows "P ⊢ ⟨es,s⟩ [⇒] ⟨es',s'⟩"
using reds eval_rest iconf bconf
proof (induct rule: converse_rtrancl_induct3)
case refl then show ?case by simp
next
case (step es1 s1 b1 es2 s2 b2)
then have ic: "iconfs (shp s2) es2" using Reds_preserves_iconf local.wf by blast
then have ec: "P,shp s2 ⊢⇩b (es2,b2) √"
using Reds_preserves_bconf local.wf step.hyps(1) step.prems(2) step.prems(3) by blast
show ?case using step ic ec extend_1_evals[OF wf step.hyps(1)] by simp
qed
text ‹ Finally, small step semantics can be simulated by big step semantics:
›
theorem
assumes wf: "wwf_J_prog P"
shows small_by_big:
"⟦P ⊢ ⟨e,s,b⟩ →* ⟨e',s',b'⟩; iconf (shp s) e; P,shp s ⊢⇩b (e,b) √; final e'⟧
⟹ P ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩"
and "⟦P ⊢ ⟨es,s,b⟩ [→]* ⟨es',s',b'⟩; iconfs (shp s) es; P,shp s ⊢⇩b (es,b) √; finals es'⟧
⟹ P ⊢ ⟨es,s⟩ [⇒] ⟨es',s'⟩"
proof -
note wf
moreover assume "P ⊢ ⟨e,s,b⟩ →* ⟨e',s',b'⟩"
moreover assume "final e'"
then have "P ⊢ ⟨e',s'⟩ ⇒ ⟨e',s'⟩"
by (simp add: eval_finalId)
moreover assume "iconf (shp s) e"
moreover assume "P,shp s ⊢⇩b (e,b) √"
ultimately show "P ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩"
by (rule extend_eval)
next
assume fins: "finals es'"
note wf
moreover assume "P ⊢ ⟨es,s,b⟩ [→]* ⟨es',s',b'⟩"
moreover have "P ⊢ ⟨es',s'⟩ [⇒] ⟨es',s'⟩" using fins
by (rule eval_finalsId)
moreover assume "iconfs (shp s) es"
moreover assume "P,shp s ⊢⇩b (es,b) √"
ultimately show "P ⊢ ⟨es,s⟩ [⇒] ⟨es',s'⟩"
by (rule extend_evals)
qed
subsection "Equivalence"
text‹ And now, the crowning achievement: ›
corollary big_iff_small:
"⟦ wwf_J_prog P; iconf (shp s) e; P,shp s ⊢⇩b (e::expr,b) √ ⟧
⟹ P ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩ = (P ⊢ ⟨e,s,b⟩ →* ⟨e',s',False⟩ ∧ final e')"
by(blast dest: big_by_small eval_final small_by_big)
corollary big_iff_small_WT:
"wwf_J_prog P ⟹ P,E ⊢ e::T ⟹ P,shp s ⊢⇩b (e,b) √ ⟹
P ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩ = (P ⊢ ⟨e,s,b⟩ →* ⟨e',s',False⟩ ∧ final e')"
by(blast dest: big_iff_small WT_nsub_RI nsub_RI_iconf)
subsection ‹ Lifting type safety to @{text"⇒"} ›
text‹ \dots and now to the big step semantics, just for fun. ›
lemma eval_preserves_sconf:
fixes s::state and s'::state
assumes "wf_J_prog P" and "P ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩" and "iconf (shp s) e"
and "P,E ⊢ e::T" and "P,E ⊢ s√"
shows "P,E ⊢ s'√"
proof -
have "P,shp s ⊢⇩b (e,False) √" by(simp add: bconf_def)
with assms show ?thesis
by(blast intro:Red_preserves_sconf Red_preserves_iconf Red_preserves_bconf big_by_small
WT_implies_WTrt wf_prog_wwf_prog)
qed
lemma eval_preserves_type:
fixes s::state
assumes wf: "wf_J_prog P"
and "P ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩" and "P,E ⊢ s√" and "iconf (shp s) e" and "P,E ⊢ e::T"
shows "∃T'. P ⊢ T' ≤ T ∧ P,E,hp s',shp s' ⊢ e':T'"
proof -
have "P,shp s ⊢⇩b (e,False) √" by(simp add: bconf_def)
with assms show ?thesis by(blast dest:big_by_small[OF wf_prog_wwf_prog[OF wf]]
WT_implies_WTrt Red_preserves_type[OF wf])
qed
end
Theory Annotate
section ‹ Program annotation ›
theory Annotate imports WellType begin
abbreviation (output)
unanFAcc :: "expr ⇒ vname ⇒ expr" ("(_∙_)" [10,10] 90) where
"unanFAcc e F == FAcc e F []"
abbreviation (output)
unanFAss :: "expr ⇒ vname ⇒ expr ⇒ expr" ("(_∙_ := _)" [10,0,90] 90) where
"unanFAss e F e' == FAss e F [] e'"
inductive
Anno :: "[J_prog,env, expr , expr] ⇒ bool"
("_,_ ⊢ _ ↝ _" [51,0,0,51]50)
and Annos :: "[J_prog,env, expr list, expr list] ⇒ bool"
("_,_ ⊢ _ [↝] _" [51,0,0,51]50)
for P :: J_prog
where
AnnoNew: "P,E ⊢ new C ↝ new C"
| AnnoCast: "P,E ⊢ e ↝ e' ⟹ P,E ⊢ Cast C e ↝ Cast C e'"
| AnnoVal: "P,E ⊢ Val v ↝ Val v"
| AnnoVarVar: "E V = ⌊T⌋ ⟹ P,E ⊢ Var V ↝ Var V"
| AnnoVarField: "⟦ E V = None; E this = ⌊Class C⌋; P ⊢ C sees V,NonStatic:T in D ⟧
⟹ P,E ⊢ Var V ↝ Var this∙V{D}"
| AnnoBinOp:
"⟦ P,E ⊢ e1 ↝ e1'; P,E ⊢ e2 ↝ e2' ⟧
⟹ P,E ⊢ e1 «bop» e2 ↝ e1' «bop» e2'"
| AnnoLAssVar:
"⟦ E V = ⌊T⌋; P,E ⊢ e ↝ e' ⟧ ⟹ P,E ⊢ V:=e ↝ V:=e'"
| AnnoLAssField:
"⟦ E V = None; E this = ⌊Class C⌋; P ⊢ C sees V,NonStatic:T in D; P,E ⊢ e ↝ e' ⟧
⟹ P,E ⊢ V:=e ↝ Var this∙V{D} := e'"
| AnnoFAcc:
"⟦ P,E ⊢ e ↝ e'; P,E ⊢ e' :: Class C; P ⊢ C sees F,NonStatic:T in D ⟧
⟹ P,E ⊢ e∙F{[]} ↝ e'∙F{D}"
| AnnoSFAcc:
"⟦ P ⊢ C sees F,Static:T in D ⟧
⟹ P,E ⊢ C∙⇩sF{[]} ↝ C∙⇩sF{D}"
| AnnoFAss: "⟦ P,E ⊢ e1 ↝ e1'; P,E ⊢ e2 ↝ e2';
P,E ⊢ e1' :: Class C; P ⊢ C sees F,NonStatic:T in D ⟧
⟹ P,E ⊢ e1∙F{[]} := e2 ↝ e1'∙F{D} := e2'"
| AnnoSFAss: "⟦ P,E ⊢ e2 ↝ e2'; P ⊢ C sees F,Static:T in D ⟧
⟹ P,E ⊢ C∙⇩sF{[]} := e2 ↝ C∙⇩sF{D} := e2'"
| AnnoCall:
"⟦ P,E ⊢ e ↝ e'; P,E ⊢ es [↝] es' ⟧
⟹ P,E ⊢ Call e M es ↝ Call e' M es'"
| AnnoSCall:
"⟦ P,E ⊢ es [↝] es' ⟧
⟹ P,E ⊢ SCall C M es ↝ SCall C M es'"
| AnnoBlock:
"P,E(V ↦ T) ⊢ e ↝ e' ⟹ P,E ⊢ {V:T; e} ↝ {V:T; e'}"
| AnnoComp: "⟦ P,E ⊢ e1 ↝ e1'; P,E ⊢ e2 ↝ e2' ⟧
⟹ P,E ⊢ e1;;e2 ↝ e1';;e2'"
| AnnoCond: "⟦ P,E ⊢ e ↝ e'; P,E ⊢ e1 ↝ e1'; P,E ⊢ e2 ↝ e2' ⟧
⟹ P,E ⊢ if (e) e1 else e2 ↝ if (e') e1' else e2'"
| AnnoLoop: "⟦ P,E ⊢ e ↝ e'; P,E ⊢ c ↝ c' ⟧
⟹ P,E ⊢ while (e) c ↝ while (e') c'"
| AnnoThrow: "P,E ⊢ e ↝ e' ⟹ P,E ⊢ throw e ↝ throw e'"
| AnnoTry: "⟦ P,E ⊢ e1 ↝ e1'; P,E(V ↦ Class C) ⊢ e2 ↝ e2' ⟧
⟹ P,E ⊢ try e1 catch(C V) e2 ↝ try e1' catch(C V) e2'"
| AnnoNil: "P,E ⊢ [] [↝] []"
| AnnoCons: "⟦ P,E ⊢ e ↝ e'; P,E ⊢ es [↝] es' ⟧
⟹ P,E ⊢ e#es [↝] e'#es'"
end
Theory JVMState
chapter ‹ Jinja Virtual Machine \label{cha:jvm} ›
section ‹ State of the JVM ›
theory JVMState imports "../Common/Objects" begin
type_synonym
pc = nat
abbreviation start_sheap :: "sheap"
where "start_sheap ≡ (λx. None)(Start ↦ (Map.empty,Done))"
definition start_sheap_preloaded :: "'m prog ⇒ sheap"
where
"start_sheap_preloaded P ≡ fold (λ(C,cl) f. f(C := Some (sblank P C, Prepared))) P (λx. None)"
subsection ‹ Frame Stack ›
datatype init_call_status = No_ics | Calling cname "cname list"
| Called "cname list" | Throwing "cname list" addr
type_synonym
frame = "val list × val list × cname × mname × pc × init_call_status"
translations
(type) "frame" <= (type) "val list × val list × char list × char list × nat × init_call_status"
fun curr_stk :: "frame ⇒ val list" where
"curr_stk (stk, loc, C, M, pc, ics) = stk"
fun curr_class :: "frame ⇒ cname" where
"curr_class (stk, loc, C, M, pc, ics) = C"
fun curr_method :: "frame ⇒ mname" where
"curr_method (stk, loc, C, M, pc, ics) = M"
fun curr_pc :: "frame ⇒ nat" where
"curr_pc (stk, loc, C, M, pc, ics) = pc"
fun init_status :: "frame ⇒ init_call_status" where
"init_status (stk, loc, C, M, pc, ics) = ics"
fun ics_of :: "frame ⇒ init_call_status" where
"ics_of fr = snd(snd(snd(snd(snd fr))))"
subsection ‹ Runtime State ›
type_synonym
jvm_state = "addr option × heap × frame list × sheap"
translations
(type) "jvm_state" <= (type) "nat option × heap × frame list × sheap"
fun frames_of :: "jvm_state ⇒ frame list" where
"frames_of (xp, h, frs, sh) = frs"
abbreviation sheap :: "jvm_state ⇒ sheap" where
"sheap js ≡ snd (snd (snd js))"
end
Theory JVMInstructions
section ‹ Instructions of the JVM ›
theory JVMInstructions imports JVMState begin
datatype
instr = Load nat
| Store nat
| Push val
| New cname
| Getfield vname cname
| Getstatic cname vname cname
| Putfield vname cname
| Putstatic cname vname cname
| Checkcast cname
| Invoke mname nat
| Invokestatic cname mname nat
| Return
| Pop
| IAdd
| Goto int
| CmpEq
| IfFalse int
| Throw
type_synonym
bytecode = "instr list"
type_synonym
ex_entry = "pc × pc × cname × pc × nat"
type_synonym
ex_table = "ex_entry list"
type_synonym
jvm_method = "nat × nat × bytecode × ex_table"
type_synonym
jvm_prog = "jvm_method prog"
translations
(type) "bytecode" <= (type) "instr list"
(type) "ex_entry" <= (type) "nat × nat × char list × nat × nat"
(type) "ex_table" <= (type) "ex_entry list"
(type) "jvm_method" <= (type) "nat × nat × bytecode × ex_table"
(type) "jvm_prog" <= (type) "jvm_method prog"
end
Theory JVMExceptions
section ‹ Exception handling in the JVM ›
theory JVMExceptions imports "../Common/Exceptions" JVMInstructions
begin
definition matches_ex_entry :: "'m prog ⇒ cname ⇒ pc ⇒ ex_entry ⇒ bool"
where
"matches_ex_entry P C pc xcp ≡
let (s, e, C', h, d) = xcp in
s ≤ pc ∧ pc < e ∧ P ⊢ C ≼⇧* C'"
primrec match_ex_table :: "'m prog ⇒ cname ⇒ pc ⇒ ex_table ⇒ (pc × nat) option"
where
"match_ex_table P C pc [] = None"
| "match_ex_table P C pc (e#es) = (if matches_ex_entry P C pc e
then Some (snd(snd(snd e)))
else match_ex_table P C pc es)"
abbreviation
ex_table_of :: "jvm_prog ⇒ cname ⇒ mname ⇒ ex_table" where
"ex_table_of P C M == snd (snd (snd (snd (snd (snd (snd (method P C M)))))))"
fun find_handler :: "jvm_prog ⇒ addr ⇒ heap ⇒ frame list ⇒ sheap ⇒ jvm_state"
where
"find_handler P a h [] sh = (Some a, h, [], sh)"
| "find_handler P a h (fr#frs) sh =
(let (stk,loc,C,M,pc,ics) = fr in
case match_ex_table P (cname_of h a) pc (ex_table_of P C M) of
None ⇒
(case M = clinit of
True ⇒ (case frs of (stk',loc',C',M',pc',ics')#frs'
⇒ (case ics' of Called Cs ⇒ (None, h, (stk',loc',C',M',pc',Throwing (C#Cs) a)#frs', sh)
| _ ⇒ (None, h, (stk',loc',C',M',pc',ics')#frs', sh)
)
| [] ⇒ (Some a, h, [], sh)
)
| _ ⇒ find_handler P a h frs sh
)
| Some pc_d ⇒ (None, h, (Addr a # drop (size stk - snd pc_d) stk, loc, C, M, fst pc_d, No_ics)#frs, sh))"
lemma find_handler_cases:
"find_handler P a h frs sh = js
⟹ (∃frs'. frs' ≠ [] ∧ js = (None, h, frs', sh)) ∨ (js = (Some a, h, [], sh))"
proof(induct P a h frs sh rule: find_handler.induct)
case 1 then show ?case by clarsimp
next
case (2 P a h fr frs sh) then show ?case
by(cases fr, auto split: bool.splits list.splits init_call_status.splits)
qed
lemma find_handler_heap[simp]:
"find_handler P a h frs sh = (xp',h',frs',sh') ⟹ h' = h"
by(auto dest: find_handler_cases)
lemma find_handler_sheap[simp]:
"find_handler P a h frs sh = (xp',h',frs',sh') ⟹ sh' = sh"
by(auto dest: find_handler_cases)
lemma find_handler_frames[simp]:
"find_handler P a h frs sh = (xp',h',frs',sh') ⟹ length frs' ≤ length frs"
proof(induct frs)
case Nil then show ?case by simp
next
case (Cons a frs) then show ?case
by(auto simp: split_beta split: bool.splits list.splits init_call_status.splits)
qed
lemma find_handler_None:
"find_handler P a h frs sh = (None, h, frs', sh') ⟹ frs' ≠ []"
by (drule find_handler_cases, clarsimp)
lemma find_handler_Some:
"find_handler P a h frs sh = (Some x, h, frs', sh') ⟹ frs' = []"
by (drule find_handler_cases, clarsimp)
lemma find_handler_Some_same_error_same_heap[simp]:
"find_handler P a h frs sh = (Some x, h', frs', sh') ⟹ x = a ∧ h = h' ∧ sh = sh'"
by(auto dest: find_handler_cases)
lemma find_handler_prealloc_pres:
assumes "preallocated h"
and fh: "find_handler P a h frs sh = (xp',h',frs',sh')"
shows "preallocated h'"
using assms find_handler_heap[OF fh] by simp
lemma find_handler_frs_tl_neq:
"ics_of f ≠ No_ics
⟹ (xp, h, f#frs, sh) ≠ find_handler P xa h' (f' # frs) sh'"
proof(induct frs arbitrary: f f')
case Nil then show ?case by(auto simp: split_beta split: bool.splits)
next
case (Cons a frs)
obtain xp1 h1 frs1 sh1 where fh: "find_handler P xa h' (a # frs) sh' = (xp1,h1,frs1,sh1)"
by(cases "find_handler P xa h' (a # frs) sh'")
then have "length frs1 ≤ length (a#frs)"
by(rule find_handler_frames[where P=P and a=xa and h=h' and frs="a#frs" and sh=sh'])
then have neq: "f#a#frs ≠ frs1" by(clarsimp dest: impossible_Cons)
then show ?case
proof(cases "find_handler P xa h' (f' # a # frs) sh' = find_handler P xa h' (a # frs) sh'")
case True then show ?thesis using neq fh by simp
next
case False then show ?thesis using Cons.prems
by(fastforce simp: split_beta split: bool.splits init_call_status.splits list.splits)
qed
qed
end
Theory JVMExecInstr
section ‹ Program Execution in the JVM ›
theory JVMExecInstr
imports JVMInstructions JVMExceptions
begin
fun create_init_frame :: "[jvm_prog, cname] ⇒ frame" where
"create_init_frame P C =
(let (D,b,Ts,T,(mxs,mxl⇩0,ins,xt)) = method P C clinit
in ([],(replicate mxl⇩0 undefined),D,clinit,0,No_ics)
)"
primrec exec_instr :: "[instr, jvm_prog, heap, val list, val list,
cname, mname, pc, init_call_status, frame list, sheap] ⇒ jvm_state"
where
exec_instr_Load:
"exec_instr (Load n) P h stk loc C⇩0 M⇩0 pc ics frs sh =
(None, h, ((loc ! n) # stk, loc, C⇩0, M⇩0, Suc pc, ics)#frs, sh)"
| exec_instr_Store:
"exec_instr (Store n) P h stk loc C⇩0 M⇩0 pc ics frs sh =
(None, h, (tl stk, loc[n:=hd stk], C⇩0, M⇩0, Suc pc, ics)#frs, sh)"
| exec_instr_Push:
"exec_instr (Push v) P h stk loc C⇩0 M⇩0 pc ics frs sh =
(None, h, (v # stk, loc, C⇩0, M⇩0, Suc pc, ics)#frs, sh)"
| exec_instr_New:
"exec_instr (New C) P h stk loc C⇩0 M⇩0 pc ics frs sh =
(case (ics, sh C) of
(Called Cs, _) ⇒
(case new_Addr h of
None ⇒ (⌊addr_of_sys_xcpt OutOfMemory⌋, h, (stk, loc, C⇩0, M⇩0, pc, No_ics)#frs, sh)
| Some a ⇒ (None, h(a↦blank P C), (Addr a#stk, loc, C⇩0, M⇩0, Suc pc, No_ics)#frs, sh)
)
| (_, Some(obj, Done)) ⇒
(case new_Addr h of
None ⇒ (⌊addr_of_sys_xcpt OutOfMemory⌋, h, (stk, loc, C⇩0, M⇩0, pc, ics)#frs, sh)
| Some a ⇒ (None, h(a↦blank P C), (Addr a#stk, loc, C⇩0, M⇩0, Suc pc, ics)#frs, sh)
)
| _ ⇒ (None, h, (stk, loc, C⇩0, M⇩0, pc, Calling C [])#frs, sh)
)"
| exec_instr_Getfield:
"exec_instr (Getfield F C) P h stk loc C⇩0 M⇩0 pc ics frs sh =
(let v = hd stk;
(D,fs) = the(h(the_Addr v));
(D',b,t) = field P C F;
xp' = if v=Null then ⌊addr_of_sys_xcpt NullPointer⌋
else if ¬(∃t b. P ⊢ D has F,b:t in C)
then ⌊addr_of_sys_xcpt NoSuchFieldError⌋
else case b of Static ⇒ ⌊addr_of_sys_xcpt IncompatibleClassChangeError⌋
| NonStatic ⇒ None
in case xp' of None ⇒ (xp', h, (the(fs(F,C))#(tl stk), loc, C⇩0, M⇩0, pc+1, ics)#frs, sh)
| Some x ⇒ (xp', h, (stk, loc, C⇩0, M⇩0, pc, ics)#frs, sh))"
| exec_instr_Getstatic:
"exec_instr (Getstatic C F D) P h stk loc C⇩0 M⇩0 pc ics frs sh =
(let (D',b,t) = field P D F;
xp' = if ¬(∃t b. P ⊢ C has F,b:t in D)
then ⌊addr_of_sys_xcpt NoSuchFieldError⌋
else case b of NonStatic ⇒ ⌊addr_of_sys_xcpt IncompatibleClassChangeError⌋
| Static ⇒ None
in (case (xp', ics, sh D') of
(Some a, _) ⇒ (xp', h, (stk, loc, C⇩0, M⇩0, pc, ics)#frs, sh)
| (_, Called Cs, _) ⇒ let (sfs, i) = the(sh D');
v = the(sfs F)
in (xp', h, (v#stk, loc, C⇩0, M⇩0, Suc pc, No_ics)#frs, sh)
| (_, _, Some (sfs, Done)) ⇒ let v = the (sfs F)
in (xp', h, (v#stk, loc, C⇩0, M⇩0, Suc pc, ics)#frs, sh)
| _ ⇒ (xp', h, (stk, loc, C⇩0, M⇩0, pc, Calling D' [])#frs, sh)
)
)"
| exec_instr_Putfield:
"exec_instr (Putfield F C) P h stk loc C⇩0 M⇩0 pc ics frs sh =
(let v = hd stk;
r = hd (tl stk);
a = the_Addr r;
(D,fs) = the (h a);
(D',b,t) = field P C F;
xp' = if r=Null then ⌊addr_of_sys_xcpt NullPointer⌋
else if ¬(∃t b. P ⊢ D has F,b:t in C)
then ⌊addr_of_sys_xcpt NoSuchFieldError⌋
else case b of Static ⇒ ⌊addr_of_sys_xcpt IncompatibleClassChangeError⌋
| NonStatic ⇒ None;
h' = h(a ↦ (D, fs((F,C) ↦ v)))
in case xp' of None ⇒ (xp', h', (tl (tl stk), loc, C⇩0, M⇩0, pc+1, ics)#frs, sh)
| Some x ⇒ (xp', h, (stk, loc, C⇩0, M⇩0, pc, ics)#frs, sh)
)"
| exec_instr_Putstatic:
"exec_instr (Putstatic C F D) P h stk loc C⇩0 M⇩0 pc ics frs sh =
(let (D',b,t) = field P D F;
xp' = if ¬(∃t b. P ⊢ C has F,b:t in D)
then ⌊addr_of_sys_xcpt NoSuchFieldError⌋
else case b of NonStatic ⇒ ⌊addr_of_sys_xcpt IncompatibleClassChangeError⌋
| Static ⇒ None
in (case (xp', ics, sh D') of
(Some a, _) ⇒ (xp', h, (stk, loc, C⇩0, M⇩0, pc, ics)#frs, sh)
| (_, Called Cs, _)
⇒ let (sfs, i) = the(sh D')
in (xp', h, (tl stk, loc, C⇩0, M⇩0, Suc pc, No_ics)#frs, sh(D':=Some ((sfs(F ↦ hd stk)), i)))
| (_, _, Some (sfs, Done))
⇒ (xp', h, (tl stk, loc, C⇩0, M⇩0, Suc pc, ics)#frs, sh(D':=Some ((sfs(F ↦ hd stk)), Done)))
| _ ⇒ (xp', h, (stk, loc, C⇩0, M⇩0, pc, Calling D' [])#frs, sh)
)
)"
| exec_instr_Checkcast:
"exec_instr (Checkcast C) P h stk loc C⇩0 M⇩0 pc ics frs sh =
(if cast_ok P C h (hd stk)
then (None, h, (stk, loc, C⇩0, M⇩0, Suc pc, ics)#frs, sh)
else (⌊addr_of_sys_xcpt ClassCast⌋, h, (stk, loc, C⇩0, M⇩0, pc, ics)#frs, sh)
)"
| exec_instr_Invoke:
"exec_instr (Invoke M n) P h stk loc C⇩0 M⇩0 pc ics frs sh =
(let ps = take n stk;
r = stk!n;
C = fst(the(h(the_Addr r)));
(D,b,Ts,T,mxs,mxl⇩0,ins,xt)= method P C M;
xp' = if r=Null then ⌊addr_of_sys_xcpt NullPointer⌋
else if ¬(∃Ts T m D b. P ⊢ C sees M,b:Ts → T = m in D)
then ⌊addr_of_sys_xcpt NoSuchMethodError⌋
else case b of Static ⇒ ⌊addr_of_sys_xcpt IncompatibleClassChangeError⌋
| NonStatic ⇒ None;
f' = ([],[r]@(rev ps)@(replicate mxl⇩0 undefined),D,M,0,No_ics)
in case xp' of None ⇒ (xp', h, f'#(stk, loc, C⇩0, M⇩0, pc, ics)#frs, sh)
| Some a ⇒ (xp', h, (stk, loc, C⇩0, M⇩0, pc, ics)#frs, sh)
)"
| exec_instr_Invokestatic:
"exec_instr (Invokestatic C M n) P h stk loc C⇩0 M⇩0 pc ics frs sh =
(let ps = take n stk;
(D,b,Ts,T,mxs,mxl⇩0,ins,xt)= method P C M;
xp' = if ¬(∃Ts T m D b. P ⊢ C sees M,b:Ts → T = m in D)
then ⌊addr_of_sys_xcpt NoSuchMethodError⌋
else case b of NonStatic ⇒ ⌊addr_of_sys_xcpt IncompatibleClassChangeError⌋
| Static ⇒ None;
f' = ([],(rev ps)@(replicate mxl⇩0 undefined),D,M,0,No_ics)
in (case (xp', ics, sh D) of
(Some a, _) ⇒ (xp', h, (stk, loc, C⇩0, M⇩0, pc, ics)#frs, sh)
| (_, Called Cs, _) ⇒ (xp', h, f'#(stk, loc, C⇩0, M⇩0, pc, No_ics)#frs, sh)
| (_, _, Some (sfs, Done)) ⇒ (xp', h, f'#(stk, loc, C⇩0, M⇩0, pc, ics)#frs, sh)
| _ ⇒ (xp', h, (stk, loc, C⇩0, M⇩0, pc, Calling D [])#frs, sh)
)
)"
| exec_instr_Return:
"exec_instr Return P h stk⇩0 loc⇩0 C⇩0 M⇩0 pc ics frs sh =
(case frs of
[] ⇒ let sh' = (case M⇩0 = clinit of True ⇒ sh(C⇩0:=Some(fst(the(sh C⇩0)), Done))
| _ ⇒ sh
)
in (None, h, [], sh')
| (stk',loc',C',m',pc',ics')#frs'
⇒ let (D,b,Ts,T,(mxs,mxl⇩0,ins,xt)) = method P C⇩0 M⇩0;
offset = case b of NonStatic ⇒ 1 | Static ⇒ 0;
(sh'', stk'', pc'') = (case M⇩0 = clinit of True ⇒ (sh(C⇩0:=Some(fst(the(sh C⇩0)), Done)), stk', pc')
| _ ⇒ (sh, (hd stk⇩0)#(drop (length Ts + offset) stk'), Suc pc')
)
in (None, h, (stk'',loc',C',m',pc'',ics')#frs', sh'')
)"
| exec_instr_Pop:
"exec_instr Pop P h stk loc C⇩0 M⇩0 pc ics frs sh = (None, h, (tl stk, loc, C⇩0, M⇩0, Suc pc, ics)#frs, sh)"
| exec_instr_IAdd:
"exec_instr IAdd P h stk loc C⇩0 M⇩0 pc ics frs sh =
(None, h, (Intg (the_Intg (hd (tl stk)) + the_Intg (hd stk))#(tl (tl stk)), loc, C⇩0, M⇩0, Suc pc, ics)#frs, sh)"
| exec_instr_IfFalse:
"exec_instr (IfFalse i) P h stk loc C⇩0 M⇩0 pc ics frs sh =
(let pc' = if hd stk = Bool False then nat(int pc+i) else pc+1
in (None, h, (tl stk, loc, C⇩0, M⇩0, pc', ics)#frs, sh))"
| exec_instr_CmpEq:
"exec_instr CmpEq P h stk loc C⇩0 M⇩0 pc ics frs sh =
(None, h, (Bool (hd (tl stk) = hd stk) # tl (tl stk), loc, C⇩0, M⇩0, Suc pc, ics)#frs, sh)"
| exec_instr_Goto:
"exec_instr (Goto i) P h stk loc C⇩0 M⇩0 pc ics frs sh =
(None, h, (stk, loc, C⇩0, M⇩0, nat(int pc+i), ics)#frs, sh)"
| exec_instr_Throw:
"exec_instr Throw P h stk loc C⇩0 M⇩0 pc ics frs sh =
(let xp' = if hd stk = Null then ⌊addr_of_sys_xcpt NullPointer⌋
else ⌊the_Addr(hd stk)⌋
in (xp', h, (stk, loc, C⇩0, M⇩0, pc, ics)#frs, sh))"
text "Given a preallocated heap, a thrown exception is either a system exception or
thrown directly by @{term Throw}."
lemma exec_instr_xcpts:
assumes "σ' = exec_instr i P h stk loc C M pc ics' frs sh"
and "fst σ' = Some a"
shows "i = (JVMInstructions.Throw) ∨ a ∈ {a. ∃x ∈ sys_xcpts. a = addr_of_sys_xcpt x}"
using assms
proof(cases i)
case (New C1) then show ?thesis using assms
proof(cases "sh C1")
case (Some a)
then obtain sfs i where sfsi: "a = (sfs,i)" by(cases a)
then show ?thesis using Some New assms
proof(cases i) qed(cases ics', auto)+
qed(cases ics', auto)
next
case (Getfield F1 C1)
obtain D' b t where field: "field P C1 F1 = (D',b,t)" by(cases "field P C1 F1")
obtain D fs where addr: "the (h (the_Addr (hd stk))) = (D,fs)" by(cases "the (h (the_Addr (hd stk)))")
show ?thesis using addr field Getfield assms
proof(cases "hd stk = Null")
case nNull:False then show ?thesis using addr field Getfield assms
proof(cases "∄t b. P ⊢ (cname_of h (the_Addr (hd stk))) has F1,b:t in C1")
case exists:False show ?thesis
proof(cases "fst(snd(field P C1 F1))")
case Static
then show ?thesis using exists nNull addr field Getfield assms
by(auto simp: sys_xcpts_def split_beta split: staticb.splits)
next
case NonStatic
then show ?thesis using exists nNull addr field Getfield assms
by(auto simp: sys_xcpts_def split_beta split: staticb.splits)
qed
qed(auto)
qed(auto)
next
case (Getstatic C1 F1 D1)
obtain D' b t where field: "field P D1 F1 = (D',b,t)" by(cases "field P D1 F1")
show ?thesis using field Getstatic assms
proof(cases "∄t b. P ⊢ C1 has F1,b:t in D1")
case exists:False then show ?thesis using field Getstatic assms
proof(cases "fst(snd(field P D1 F1))")
case Static
then obtain sfs i where "the(sh D') = (sfs, i)" by(cases "the(sh D')")
then show ?thesis using exists field Static Getstatic assms by(cases ics'; cases i, auto)
qed(auto)
qed(auto)
next
case (Putfield F1 C1)
let ?r = "hd(tl stk)"
obtain D' b t where field: "field P C1 F1 = (D',b,t)" by(cases "field P C1 F1")
obtain D fs where addr: "the (h (the_Addr ?r)) = (D,fs)"
by(cases "the (h (the_Addr ?r))")
show ?thesis using addr field Putfield assms
proof(cases "?r = Null")
case nNull:False then show ?thesis using addr field Putfield assms
proof(cases "∄t b. P ⊢ (cname_of h (the_Addr ?r)) has F1,b:t in C1")
case exists:False show ?thesis
proof(cases b)
case Static
then show ?thesis using exists nNull addr field Putfield assms
by(auto simp: sys_xcpts_def split_beta split: staticb.splits)
next
case NonStatic
then show ?thesis using exists nNull addr field Putfield assms
by(auto simp: sys_xcpts_def split_beta split: staticb.splits)
qed
qed(auto)
qed(auto)
next
case (Putstatic C1 F1 D1)
obtain D' b t where field: "field P D1 F1 = (D',b,t)" by(cases "field P D1 F1")
show ?thesis using field Putstatic assms
proof(cases "∄t b. P ⊢ C1 has F1,b:t in D1")
case exists:False then show ?thesis using field Putstatic assms
proof(cases b)
case Static
then obtain sfs i where "the(sh D') = (sfs, i)" by(cases "the(sh D')")
then show ?thesis using exists field Static Putstatic assms by(cases ics'; cases i, auto)
qed(auto)
qed(auto)
next
case (Checkcast C1) then show ?thesis using assms by(cases "cast_ok P C1 h (hd stk)", auto)
next
case (Invoke M n)
let ?r = "stk!n"
let ?C = "cname_of h (the_Addr ?r)"
show ?thesis using Invoke assms
proof(cases "?r = Null")
case nNull:False then show ?thesis using Invoke assms
proof(cases "¬(∃Ts T m D b. P ⊢ ?C sees M,b:Ts → T = m in D)")
case exists:False then show ?thesis using nNull Invoke assms
proof(cases "fst(snd(method P ?C M))")
case Static
then show ?thesis using exists nNull Invoke assms
by(auto simp: sys_xcpts_def split_beta split: staticb.splits)
next
case NonStatic
then show ?thesis using exists nNull Invoke assms
by(auto simp: sys_xcpts_def split_beta split: staticb.splits)
qed
qed(auto)
qed(auto)
next
case (Invokestatic C1 M n)
show ?thesis using Invokestatic assms
proof(cases "¬(∃Ts T m D b. P ⊢ C1 sees M,b:Ts → T = m in D)")
case exists:False then show ?thesis using Invokestatic assms
proof(cases "fst(snd(method P C1 M))")
case Static
then obtain sfs i where "the(sh (fst(method P C1 M))) = (sfs, i)"
by(cases "the(sh (fst(method P C1 M)))")
then show ?thesis using exists Static Invokestatic assms
by(auto split: init_call_status.splits init_state.splits)
qed(auto)
qed(auto)
next
case Return then show ?thesis using assms
proof(cases frs)
case (Cons f frs') then show ?thesis using Return assms
by(cases f, cases "method P C M", cases "M=clinit", auto)
qed(auto)
next
case (IfFalse x17) then show ?thesis using assms
proof(cases "hd stk")
case (Bool b) then show ?thesis using IfFalse assms by(cases b, auto)
qed(auto)
qed(auto)
lemma exec_instr_prealloc_pres:
assumes "preallocated h"
and "exec_instr i P h stk loc C⇩0 M⇩0 pc ics frs sh = (xp',h',frs',sh')"
shows "preallocated h'"
using assms
proof(cases i)
case (New C1)
then obtain sfs i where sfsi: "the(sh C1) = (sfs,i)" by(cases "the(sh C1)")
then show ?thesis using preallocated_new[of h] New assms
by(cases "blank P C1", auto dest: new_Addr_SomeD split: init_call_status.splits init_state.splits)
next
case (Getfield F1 C1) then show ?thesis using assms
by(cases "the (h (the_Addr (hd stk)))", cases "field P C1 F1", auto)
next
case (Getstatic C1 F1 D1)
then obtain sfs i where sfsi: "the(sh (fst (field P D1 F1))) = (sfs, i)"
by(cases "the(sh (fst (field P D1 F1)))")
then show ?thesis using Getstatic assms
by(cases "field P D1 F1", auto split: init_call_status.splits init_state.splits)
next
case (Putfield F1 C1) then show ?thesis using preallocated_new preallocated_upd_obj assms
by(cases "the (h (the_Addr (hd (tl stk))))", cases "field P C1 F1", auto, metis option.collapse)
next
case (Putstatic C1 F1 D1)
then obtain sfs i where sfsi: "the(sh (fst (field P D1 F1))) = (sfs, i)"
by(cases "the(sh (fst (field P D1 F1)))")
then show ?thesis using Putstatic assms
by(cases "field P D1 F1", auto split: init_call_status.splits init_state.splits)
next
case (Checkcast C1)
then show ?thesis using assms
proof(cases "hd stk = Null")
case False then show ?thesis
using Checkcast assms
by(cases "P ⊢ cname_of h (the_Addr (hd stk)) ≼⇧* C1", auto simp: cast_ok_def)
qed(simp add: cast_ok_def)
next
case (Invoke M n)
then show ?thesis using assms by(cases "method P (cname_of h (the_Addr (stk ! n))) M", auto)
next
case (Invokestatic C1 M n)
show ?thesis
proof(cases "sh (fst (method P C1 M))")
case None then show ?thesis using Invokestatic assms
by(cases "method P C1 M", auto split: init_call_status.splits)
next
case (Some a)
then obtain sfs i where sfsi: "a = (sfs, i)" by(cases a)
then show ?thesis using Some Invokestatic assms
proof(cases i) qed(cases "method P C1 M", auto split: init_call_status.splits)+
qed
next
case Return
then show ?thesis using assms by(cases "method P C⇩0 M⇩0", auto simp: split_beta split: list.splits)
next
case (IfFalse x17) then show ?thesis using assms by(auto split: val.splits bool.splits)
next
case Throw then show ?thesis using assms by(auto split: val.splits)
qed(auto)
end
Theory JVMExec
section ‹ Program Execution in the JVM in full small step style ›
theory JVMExec
imports JVMExecInstr
begin
abbreviation
instrs_of :: "jvm_prog ⇒ cname ⇒ mname ⇒ instr list" where
"instrs_of P C M == fst(snd(snd(snd(snd(snd(snd(method P C M)))))))"
fun curr_instr :: "jvm_prog ⇒ frame ⇒ instr" where
"curr_instr P (stk,loc,C,M,pc,ics) = instrs_of P C M ! pc"
fun exec_Calling :: "[cname, cname list, jvm_prog, heap, val list, val list,
cname, mname, pc, frame list, sheap] ⇒ jvm_state"
where
"exec_Calling C Cs P h stk loc C⇩0 M⇩0 pc frs sh =
(case sh C of
None ⇒ (None, h, (stk, loc, C⇩0, M⇩0, pc, Calling C Cs)#frs, sh(C := Some (sblank P C, Prepared)))
| Some (obj, iflag) ⇒
(case iflag of
Done ⇒ (None, h, (stk, loc, C⇩0, M⇩0, pc, Called Cs)#frs, sh)
| Processing ⇒ (None, h, (stk, loc, C⇩0, M⇩0, pc, Called Cs)#frs, sh)
| Error ⇒ (None, h, (stk, loc, C⇩0, M⇩0, pc,
Throwing Cs (addr_of_sys_xcpt NoClassDefFoundError))#frs, sh)
| Prepared ⇒
let sh' = sh(C:=Some(fst(the(sh C)), Processing));
D = fst(the(class P C))
in if C = Object
then (None, h, (stk, loc, C⇩0, M⇩0, pc, Called (C#Cs))#frs, sh')
else (None, h, (stk, loc, C⇩0, M⇩0, pc, Calling D (C#Cs))#frs, sh')
)
)"
fun exec_step :: "[jvm_prog, heap, val list, val list,
cname, mname, pc, init_call_status, frame list, sheap] ⇒ jvm_state"
where
"exec_step P h stk loc C M pc (Calling C' Cs) frs sh
= exec_Calling C' Cs P h stk loc C M pc frs sh" |
"exec_step P h stk loc C M pc (Called (C'#Cs)) frs sh
= (None, h, create_init_frame P C'#(stk, loc, C, M, pc, Called Cs)#frs, sh)" |
"exec_step P h stk loc C M pc (Throwing (C'#Cs) a) frs sh
= (None, h, (stk,loc,C,M,pc,Throwing Cs a)#frs, sh(C':=Some(fst(the(sh C')), Error)))" |
"exec_step P h stk loc C M pc (Throwing [] a) frs sh
= (⌊a⌋, h, (stk,loc,C,M,pc,No_ics)#frs, sh)" |
"exec_step P h stk loc C M pc ics frs sh
= exec_instr (instrs_of P C M ! pc) P h stk loc C M pc ics frs sh"
fun exec :: "jvm_prog × jvm_state ⇒ jvm_state option" where
"exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh) =
(let (xp', h', frs', sh') = exec_step P h stk loc C M pc ics frs sh
in case xp' of
None ⇒ Some (None,h',frs',sh')
| Some x ⇒ Some (find_handler P x h ((stk,loc,C,M,pc,ics)#frs) sh)
)"
| "exec _ = None"
inductive_set
exec_1 :: "jvm_prog ⇒ (jvm_state × jvm_state) set"
and exec_1' :: "jvm_prog ⇒ jvm_state ⇒ jvm_state ⇒ bool"
("_ ⊢/ _ -jvm→⇩1/ _" [61,61,61] 60)
for P :: jvm_prog
where
"P ⊢ σ -jvm→⇩1 σ' ≡ (σ,σ') ∈ exec_1 P"
| exec_1I: "exec (P,σ) = Some σ' ⟹ P ⊢ σ -jvm→⇩1 σ'"
definition exec_all :: "jvm_prog ⇒ jvm_state ⇒ jvm_state ⇒ bool"
("(_ ⊢/ _ -jvm→/ _)" [61,61,61]60) where
exec_all_def1: "P ⊢ σ -jvm→ σ' ⟷ (σ,σ') ∈ (exec_1 P)⇧*"
notation (ASCII)
exec_all ("_ |-/ _ -jvm->/ _" [61,61,61]60)
lemma exec_1_eq:
"exec_1 P = {(σ,σ'). exec (P,σ) = Some σ'}"
by (auto intro: exec_1I elim: exec_1.cases)
lemma exec_1_iff:
"P ⊢ σ -jvm→⇩1 σ' = (exec (P,σ) = Some σ')"
by (simp add: exec_1_eq)
lemma exec_all_def:
"P ⊢ σ -jvm→ σ' = ((σ,σ') ∈ {(σ,σ'). exec (P,σ) = Some σ'}⇧*)"
by (simp add: exec_all_def1 exec_1_eq)
lemma jvm_refl[iff]: "P ⊢ σ -jvm→ σ"
by(simp add: exec_all_def)
lemma jvm_trans[trans]:
"⟦ P ⊢ σ -jvm→ σ'; P ⊢ σ' -jvm→ σ'' ⟧ ⟹ P ⊢ σ -jvm→ σ''"
by(simp add: exec_all_def)
lemma jvm_one_step1[trans]:
"⟦ P ⊢ σ -jvm→⇩1 σ'; P ⊢ σ' -jvm→ σ'' ⟧ ⟹ P ⊢ σ -jvm→ σ''"
by (simp add: exec_all_def1)
lemma jvm_one_step2[trans]:
"⟦ P ⊢ σ -jvm→ σ'; P ⊢ σ' -jvm→⇩1 σ'' ⟧ ⟹ P ⊢ σ -jvm→ σ''"
by (simp add: exec_all_def1)
lemma exec_all_conf:
"⟦ P ⊢ σ -jvm→ σ'; P ⊢ σ -jvm→ σ'' ⟧
⟹ P ⊢ σ' -jvm→ σ'' ∨ P ⊢ σ'' -jvm→ σ'"
by(simp add: exec_all_def single_valued_def single_valued_confluent)
lemma exec_1_exec_all_conf:
"⟦ exec (P, σ) = Some σ'; P ⊢ σ -jvm→ σ''; σ ≠ σ'' ⟧
⟹ P ⊢ σ' -jvm→ σ''"
by(auto elim: converse_rtranclE simp: exec_1_eq exec_all_def)
lemma exec_all_finalD: "P ⊢ (x, h, [], sh) -jvm→ σ ⟹ σ = (x, h, [], sh)"
proof -
assume "P ⊢ (x, h, [], sh) -jvm→ σ"
then have "((x, h, [], sh), σ) ∈ {(σ, σ'). exec (P, σ) = ⌊σ'⌋}⇧*"
by(simp only: exec_all_def)
then show ?thesis proof(rule converse_rtranclE) qed simp+
qed
lemma exec_all_deterministic:
"⟦ P ⊢ σ -jvm→ (x,h,[],sh); P ⊢ σ -jvm→ σ' ⟧ ⟹ P ⊢ σ' -jvm→ (x,h,[],sh)"
proof -
assume assms: "P ⊢ σ -jvm→ (x,h,[],sh)" "P ⊢ σ -jvm→ σ'"
show ?thesis using exec_all_conf[OF assms]
by(blast dest!: exec_all_finalD)
qed
subsection "Preservation of preallocated"
lemma exec_Calling_prealloc_pres:
assumes "preallocated h"
and "exec_Calling C Cs P h stk loc C⇩0 M⇩0 pc frs sh = (xp',h',frs',sh')"
shows "preallocated h'"
using assms
proof(cases "sh C")
case (Some a)
then obtain sfs i where sfsi:"a = (sfs, i)" by(cases a)
then show ?thesis using Some assms
proof(cases i)
case Prepared
then show ?thesis using sfsi Some assms by(cases "method P C clinit", auto split: if_split_asm)
next
case Error
then show ?thesis using sfsi Some assms by(cases "method P C clinit", auto)
qed(auto)
qed(auto)
lemma exec_step_prealloc_pres:
assumes pre: "preallocated h"
and "exec_step P h stk loc C M pc ics frs sh = (xp',h',frs',sh')"
shows "preallocated h'"
proof(cases ics)
case No_ics
then show ?thesis using exec_instr_prealloc_pres assms by auto
next
case Calling
then show ?thesis using exec_Calling_prealloc_pres assms by auto
next
case (Called Cs)
then show ?thesis using exec_instr_prealloc_pres assms by(cases Cs, auto)
next
case (Throwing Cs a)
then show ?thesis using assms by(cases Cs, auto)
qed
lemma exec_prealloc_pres:
assumes pre: "preallocated h"
and "exec (P, xp, h, frs, sh) = Some(xp',h',frs',sh')"
shows "preallocated h'"
using assms
proof(cases "∃x. xp = ⌊x⌋ ∨ frs = []")
case False
then obtain f1 frs1 where frs: "frs = f1#frs1" by(cases frs, simp+)
then obtain stk1 loc1 C1 M1 pc1 ics1 where f1: "f1 = (stk1,loc1,C1,M1,pc1,ics1)" by(cases f1)
let ?i = "instrs_of P C1 M1 ! pc1"
obtain xp2 h2 frs2 sh2
where exec_step: "exec_step P h stk1 loc1 C1 M1 pc1 ics1 frs1 sh = (xp2,h2,frs2,sh2)"
by(cases "exec_step P h stk1 loc1 C1 M1 pc1 ics1 frs1 sh")
then show ?thesis using exec_step_prealloc_pres[OF pre exec_step] f1 frs False assms
proof(cases xp2)
case (Some a)
show ?thesis
using find_handler_prealloc_pres[OF pre, where a=a]
exec_step_prealloc_pres[OF pre]
exec_step f1 frs Some False assms
by(auto split: bool.splits init_call_status.splits list.splits)
qed(auto split: init_call_status.splits)
qed(auto)
subsection "Start state"
text ‹ The @{term Start} class is defined based on a given initial class
and method. It has two methods: one that calls the initial method in the
initial class, which is called by the starting program, and @{term clinit},
as required for the class to be well-formed. ›
definition start_method :: "cname ⇒ mname ⇒ jvm_method mdecl" where
"start_method C M = (start_m, Static, [], Void, (1,0,[Invokestatic C M 0,Return],[]))"
abbreviation start_clinit :: "jvm_method mdecl" where
"start_clinit ≡ (clinit, Static, [], Void, (1,0,[Push Unit,Return],[]))"
definition start_class :: "cname ⇒ mname ⇒ jvm_method cdecl" where
"start_class C M = (Start, Object, [], [start_method C M, start_clinit])"
text ‹
The start configuration of the JVM in program @{text P}:
in the start heap, we call the ``start'' method of the
``Start''; this method performs @{text Invokestatic} on the
class and method given to create the start program's @{term Start} class.
This allows the initialization procedure to be called on the
initial class in a natural way before the initial method is performed.
There is no @{text this} pointer of the frame as @{term start} is @{term Static}.
The start sheap has every class pre-prepared; this decision is not
necessary.
The starting program includes the added @{term Start} class, given a
method @{text M} of class @{text C}, added to program @{text P}.
›
definition start_state :: "jvm_prog ⇒ jvm_state" where
"start_state P = (None, start_heap P, [([], [], Start, start_m, 0, No_ics)], start_sheap)"
abbreviation start_prog :: "jvm_prog ⇒ cname ⇒ mname ⇒ jvm_prog" where
"start_prog P C M ≡ start_class C M # P"
endTheory JVMDefensive
section ‹ A Defensive JVM ›
theory JVMDefensive
imports JVMExec "../Common/Conform"
begin
text ‹
Extend the state space by one element indicating a type error (or
other abnormal termination) ›
datatype 'a type_error = TypeError | Normal 'a
fun is_Addr :: "val ⇒ bool" where
"is_Addr (Addr a) ⟷ True"
| "is_Addr v ⟷ False"
fun is_Intg :: "val ⇒ bool" where
"is_Intg (Intg i) ⟷ True"
| "is_Intg v ⟷ False"
fun is_Bool :: "val ⇒ bool" where
"is_Bool (Bool b) ⟷ True"
| "is_Bool v ⟷ False"
definition is_Ref :: "val ⇒ bool" where
"is_Ref v ⟷ v = Null ∨ is_Addr v"
primrec check_instr :: "[instr, jvm_prog, heap, val list, val list,
cname, mname, pc, frame list, sheap] ⇒ bool" where
check_instr_Load:
"check_instr (Load n) P h stk loc C M⇩0 pc frs sh =
(n < length loc)"
| check_instr_Store:
"check_instr (Store n) P h stk loc C⇩0 M⇩0 pc frs sh =
(0 < length stk ∧ n < length loc)"
| check_instr_Push:
"check_instr (Push v) P h stk loc C⇩0 M⇩0 pc frs sh =
(¬is_Addr v)"
| check_instr_New:
"check_instr (New C) P h stk loc C⇩0 M⇩0 pc frs sh =
is_class P C"
| check_instr_Getfield:
"check_instr (Getfield F C) P h stk loc C⇩0 M⇩0 pc frs sh =
(0 < length stk ∧ (∃C' T. P ⊢ C sees F,NonStatic:T in C') ∧
(let (C', b, T) = field P C F; ref = hd stk in
C' = C ∧ is_Ref ref ∧ (ref ≠ Null ⟶
h (the_Addr ref) ≠ None ∧
(let (D,vs) = the (h (the_Addr ref)) in
P ⊢ D ≼⇧* C ∧ vs (F,C) ≠ None ∧ P,h ⊢ the (vs (F,C)) :≤ T))))"
| check_instr_Getstatic:
"check_instr (Getstatic C F D) P h stk loc C⇩0 M⇩0 pc frs sh =
((∃T. P ⊢ C sees F,Static:T in D) ∧
(let (C', b, T) = field P C F in
C' = D ∧ (sh D ≠ None ⟶
(let (sfs,i) = the (sh D) in
sfs F ≠ None ∧ P,h ⊢ the (sfs F) :≤ T))))"
| check_instr_Putfield:
"check_instr (Putfield F C) P h stk loc C⇩0 M⇩0 pc frs sh =
(1 < length stk ∧ (∃C' T. P ⊢ C sees F,NonStatic:T in C') ∧
(let (C', b, T) = field P C F; v = hd stk; ref = hd (tl stk) in
C' = C ∧ is_Ref ref ∧ (ref ≠ Null ⟶
h (the_Addr ref) ≠ None ∧
(let D = fst (the (h (the_Addr ref))) in
P ⊢ D ≼⇧* C ∧ P,h ⊢ v :≤ T))))"
| check_instr_Putstatic:
"check_instr (Putstatic C F D) P h stk loc C⇩0 M⇩0 pc frs sh =
(0 < length stk ∧ (∃T. P ⊢ C sees F,Static:T in D) ∧
(let (C', b, T) = field P C F; v = hd stk in
C' = D ∧ P,h ⊢ v :≤ T))"
| check_instr_Checkcast:
"check_instr (Checkcast C) P h stk loc C⇩0 M⇩0 pc frs sh =
(0 < length stk ∧ is_class P C ∧ is_Ref (hd stk))"
| check_instr_Invoke:
"check_instr (Invoke M n) P h stk loc C⇩0 M⇩0 pc frs sh =
(n < length stk ∧ is_Ref (stk!n) ∧
(stk!n ≠ Null ⟶
(let a = the_Addr (stk!n);
C = cname_of h a;
Ts = fst (snd (snd (method P C M)))
in h a ≠ None ∧ P ⊢ C has M,NonStatic ∧
P,h ⊢ rev (take n stk) [:≤] Ts)))"
| check_instr_Invokestatic:
"check_instr (Invokestatic C M n) P h stk loc C⇩0 M⇩0 pc frs sh =
(n ≤ length stk ∧
(let Ts = fst (snd (snd (method P C M)))
in P ⊢ C has M,Static ∧
P,h ⊢ rev (take n stk) [:≤] Ts))"
| check_instr_Return:
"check_instr Return P h stk loc C⇩0 M⇩0 pc frs sh =
(case (M⇩0 = clinit) of False ⇒ (0 < length stk ∧ ((0 < length frs) ⟶
(∃b. P ⊢ C⇩0 has M⇩0,b) ∧
(let v = hd stk;
T = fst (snd (snd (snd (method P C⇩0 M⇩0))))
in P,h ⊢ v :≤ T)))
| True ⇒ P ⊢ C⇩0 has M⇩0,Static)"
| check_instr_Pop:
"check_instr Pop P h stk loc C⇩0 M⇩0 pc frs sh =
(0 < length stk)"
| check_instr_IAdd:
"check_instr IAdd P h stk loc C⇩0 M⇩0 pc frs sh =
(1 < length stk ∧ is_Intg (hd stk) ∧ is_Intg (hd (tl stk)))"
| check_instr_IfFalse:
"check_instr (IfFalse b) P h stk loc C⇩0 M⇩0 pc frs sh =
(0 < length stk ∧ is_Bool (hd stk) ∧ 0 ≤ int pc+b)"
| check_instr_CmpEq:
"check_instr CmpEq P h stk loc C⇩0 M⇩0 pc frs sh =
(1 < length stk)"
| check_instr_Goto:
"check_instr (Goto b) P h stk loc C⇩0 M⇩0 pc frs sh =
(0 ≤ int pc+b)"
| check_instr_Throw:
"check_instr Throw P h stk loc C⇩0 M⇩0 pc frs sh =
(0 < length stk ∧ is_Ref (hd stk))"
definition check :: "jvm_prog ⇒ jvm_state ⇒ bool" where
"check P σ = (let (xcpt, h, frs, sh) = σ in
(case frs of [] ⇒ True | (stk,loc,C,M,pc,ics)#frs' ⇒
∃b. P ⊢ C has M, b ∧
(let (C',b,Ts,T,mxs,mxl⇩0,ins,xt) = method P C M; i = ins!pc in
pc < size ins ∧ size stk ≤ mxs ∧
check_instr i P h stk loc C M pc frs' sh)))"
definition exec_d :: "jvm_prog ⇒ jvm_state ⇒ jvm_state option type_error" where
"exec_d P σ = (if check P σ then Normal (exec (P, σ)) else TypeError)"
inductive_set
exec_1_d :: "jvm_prog ⇒ (jvm_state type_error × jvm_state type_error) set"
and exec_1_d' :: "jvm_prog ⇒ jvm_state type_error ⇒ jvm_state type_error ⇒ bool"
("_ ⊢ _ -jvmd→⇩1 _" [61,61,61]60)
for P :: jvm_prog
where
"P ⊢ σ -jvmd→⇩1 σ' ≡ (σ,σ') ∈ exec_1_d P"
| exec_1_d_ErrorI: "exec_d P σ = TypeError ⟹ P ⊢ Normal σ -jvmd→⇩1 TypeError"
| exec_1_d_NormalI: "exec_d P σ = Normal (Some σ') ⟹ P ⊢ Normal σ -jvmd→⇩1 Normal σ'"
definition exec_all_d :: "jvm_prog ⇒ jvm_state type_error ⇒ jvm_state type_error ⇒ bool"
("_ ⊢ _ -jvmd→ _" [61,61,61]60) where
exec_all_d_def1: "P ⊢ σ -jvmd→ σ' ⟷ (σ,σ') ∈ (exec_1_d P)⇧*"
notation (ASCII)
"exec_all_d" ("_ |- _ -jvmd-> _" [61,61,61]60)
lemma exec_1_d_eq:
"exec_1_d P = {(s,t). ∃σ. s = Normal σ ∧ t = TypeError ∧ exec_d P σ = TypeError} ∪
{(s,t). ∃σ σ'. s = Normal σ ∧ t = Normal σ' ∧ exec_d P σ = Normal (Some σ')}"
by (auto elim!: exec_1_d.cases intro!: exec_1_d.intros)
declare split_paired_All [simp del]
declare split_paired_Ex [simp del]
lemma if_neq [dest!]:
"(if P then A else B) ≠ B ⟹ P"
by (cases P, auto)
lemma exec_d_no_errorI [intro]:
"check P σ ⟹ exec_d P σ ≠ TypeError"
by (unfold exec_d_def) simp
theorem no_type_error_commutes:
"exec_d P σ ≠ TypeError ⟹ exec_d P σ = Normal (exec (P, σ))"
by (unfold exec_d_def, auto)
lemma defensive_imp_aggressive:
"P ⊢ (Normal σ) -jvmd→ (Normal σ') ⟹ P ⊢ σ -jvm→ σ'"
proof -
have "⋀x y. P ⊢ x -jvmd→ y ⟹ ∀σ σ'. x = Normal σ ⟶ y = Normal σ' ⟶ P ⊢ σ -jvm→ σ'"
proof -
fix x y assume xy: "P ⊢ x -jvmd→ y"
then have "(x, y) ∈ (exec_1_d P)⇧*" by (unfold exec_all_d_def1)
then show "∀σ σ'. x = Normal σ ⟶ y = Normal σ' ⟶ P ⊢ σ -jvm→ σ'"
proof(induct rule: rtrancl_induct)
case base
then show ?case by (simp add: exec_all_def)
next
case (step y' z')
show ?case proof(induct rule: exec_1_d.cases[OF step.hyps(2)])
case (2 σ σ')
then have "(σ, σ') ∈ {(σ, σ'). exec (P, σ) = ⌊σ'⌋}⇧*" using step
by(fastforce simp: exec_d_def split: type_error.splits if_split_asm)
then show ?case using step 2 by (auto simp: exec_all_def)
qed simp
qed
qed
moreover
assume "P ⊢ (Normal σ) -jvmd→ (Normal σ')"
ultimately
show "P ⊢ σ -jvm→ σ'" by blast
qed
end
Theory SemiType
section ‹ The Jinja Type System as a Semilattice ›
theory SemiType
imports "../Common/WellForm" Jinja.Semilattices
begin
definition super :: "'a prog ⇒ cname ⇒ cname"
where "super P C ≡ fst (the (class P C))"
lemma superI:
"(C,D) ∈ subcls1 P ⟹ super P C = D"
by (unfold super_def) (auto dest: subcls1D)
primrec the_Class :: "ty ⇒ cname"
where
"the_Class (Class C) = C"
definition sup :: "'c prog ⇒ ty ⇒ ty ⇒ ty err"
where
"sup P T⇩1 T⇩2 ≡
if is_refT T⇩1 ∧ is_refT T⇩2 then
OK (if T⇩1 = NT then T⇩2 else
if T⇩2 = NT then T⇩1 else
(Class (exec_lub (subcls1 P) (super P) (the_Class T⇩1) (the_Class T⇩2))))
else
(if T⇩1 = T⇩2 then OK T⇩1 else Err)"
lemma sup_def':
"sup P = (λT⇩1 T⇩2.
if is_refT T⇩1 ∧ is_refT T⇩2 then
OK (if T⇩1 = NT then T⇩2 else
if T⇩2 = NT then T⇩1 else
(Class (exec_lub (subcls1 P) (super P) (the_Class T⇩1) (the_Class T⇩2))))
else
(if T⇩1 = T⇩2 then OK T⇩1 else Err))"
by (simp add: sup_def fun_eq_iff)
abbreviation
subtype :: "'c prog ⇒ ty ⇒ ty ⇒ bool"
where "subtype P ≡ widen P"
definition esl :: "'c prog ⇒ ty esl"
where
"esl P ≡ (types P, subtype P, sup P)"
lemma is_class_is_subcls:
"wf_prog m P ⟹ is_class P C = P ⊢ C ≼⇧* Object"
by (fastforce simp:is_class_def
elim: subcls_C_Object converse_rtranclE subcls1I
dest: subcls1D)
lemma subcls_antisym:
"⟦wf_prog m P; P ⊢ C ≼⇧* D; P ⊢ D ≼⇧* C⟧ ⟹ C = D"
by (auto dest: acyclic_subcls1 acyclic_impl_antisym_rtrancl antisymD)
lemma widen_antisym:
"⟦ wf_prog m P; P ⊢ T ≤ U; P ⊢ U ≤ T ⟧ ⟹ T = U"
apply (cases T)
apply (cases U)
apply auto
apply (cases U)
apply (auto elim!: subcls_antisym)
done
lemma order_widen [intro,simp]:
"wf_prog m P ⟹ order (subtype P)"
apply (unfold Semilat.order_def lesub_def)
apply (auto intro: widen_trans widen_antisym)
done
lemma NT_widen:
"P ⊢ NT ≤ T = (T = NT ∨ (∃C. T = Class C))"
by (cases T) auto
lemma Class_widen2: "P ⊢ Class C ≤ T = (∃D. T = Class D ∧ P ⊢ C ≼⇧* D)"
by (cases T) auto
lemma wf_converse_subcls1_impl_acc_subtype:
"wf ((subcls1 P)^-1) ⟹ acc (subtype P)"
apply (unfold Semilat.acc_def lesssub_def)
apply (drule_tac p = "(subcls1 P)^-1 - Id" in wf_subset)
apply blast
apply (drule wf_trancl)
apply (simp add: wf_eq_minimal)
apply clarify
apply (unfold lesub_def)
apply (rename_tac M T)
apply (case_tac "∃C. Class C ∈ M")
prefer 2
apply (case_tac T)
apply fastforce
apply fastforce
apply fastforce
apply simp
apply (rule_tac x = NT in bexI)
apply (rule allI)
apply (rule impI, erule conjE)
apply (clarsimp simp add: NT_widen)
apply simp
apply clarsimp
apply (erule_tac x = "{C. Class C : M}" in allE)
apply auto
apply (rename_tac D)
apply (rule_tac x = "Class D" in bexI)
prefer 2
apply assumption
apply clarify
apply (clarsimp simp: Class_widen2)
apply (insert rtrancl_r_diff_Id [symmetric, of "subcls1 P"])
apply simp
apply (erule rtranclE)
apply blast
apply (drule rtrancl_converseI)
apply (subgoal_tac "((subcls1 P)-Id)^-1 = ((subcls1 P)^-1 - Id)")
prefer 2
apply blast
apply simp
apply (blast intro: rtrancl_into_trancl2)
done
lemma wf_subtype_acc [intro, simp]:
"wf_prog wf_mb P ⟹ acc (subtype P)"
by (rule wf_converse_subcls1_impl_acc_subtype, rule wf_subcls1)
lemma exec_lub_refl [simp]: "exec_lub r f T T = T"
by (simp add: exec_lub_def while_unfold)
lemma closed_err_types:
"wf_prog wf_mb P ⟹ closed (err (types P)) (lift2 (sup P))"
apply (unfold closed_def plussub_def lift2_def sup_def')
apply (frule acyclic_subcls1)
apply (frule single_valued_subcls1)
apply (auto simp: is_type_def is_refT_def is_class_is_subcls split: err.split ty.splits)
apply (blast dest!: is_lub_exec_lub is_lubD is_ubD intro!: is_ubI superI)
done
lemma sup_subtype_greater:
"⟦ wf_prog wf_mb P; is_type P t1; is_type P t2; sup P t1 t2 = OK s ⟧
⟹ subtype P t1 s ∧ subtype P t2 s"
proof -
assume wf_prog: "wf_prog wf_mb P"
{ fix c1 c2
assume is_class: "is_class P c1" "is_class P c2"
with wf_prog
obtain
"P ⊢ c1 ≼⇧* Object"
"P ⊢ c2 ≼⇧* Object"
by (blast intro: subcls_C_Object)
with single_valued_subcls1[OF wf_prog]
obtain u where
"is_lub ((subcls1 P)^* ) c1 c2 u"
by (blast dest: single_valued_has_lubs)
moreover
note acyclic_subcls1[OF wf_prog]
moreover
have "∀x y. (x, y) ∈ subcls1 P ⟶ super P x = y"
by (blast intro: superI)
ultimately
have "P ⊢ c1 ≼⇧* exec_lub (subcls1 P) (super P) c1 c2 ∧
P ⊢ c2 ≼⇧* exec_lub (subcls1 P) (super P) c1 c2"
by (simp add: exec_lub_conv) (blast dest: is_lubD is_ubD)
} note this [simp]
assume "is_type P t1" "is_type P t2" "sup P t1 t2 = OK s"
thus ?thesis
apply (unfold sup_def)
apply (cases s)
apply (auto simp add: is_refT_def split: if_split_asm)
done
qed
lemma sup_subtype_smallest:
"⟦ wf_prog wf_mb P; is_type P a; is_type P b; is_type P c;
subtype P a c; subtype P b c; sup P a b = OK d ⟧
⟹ subtype P d c"
proof -
assume wf_prog: "wf_prog wf_mb P"
{ fix c1 c2 D
assume is_class: "is_class P c1" "is_class P c2"
assume le: "P ⊢ c1 ≼⇧* D" "P ⊢ c2 ≼⇧* D"
from wf_prog is_class
obtain
"P ⊢ c1 ≼⇧* Object"
"P ⊢ c2 ≼⇧* Object"
by (blast intro: subcls_C_Object)
with single_valued_subcls1[OF wf_prog]
obtain u where
lub: "is_lub ((subcls1 P)^* ) c1 c2 u"
by (blast dest: single_valued_has_lubs)
with acyclic_subcls1[OF wf_prog]
have "exec_lub (subcls1 P) (super P) c1 c2 = u"
by (blast intro: superI exec_lub_conv)
moreover
from lub le
have "P ⊢ u ≼⇧* D"
by (simp add: is_lub_def is_ub_def)
ultimately
have "P ⊢ exec_lub (subcls1 P) (super P) c1 c2 ≼⇧* D"
by blast
} note this [intro]
have [dest!]:
"⋀C T. P ⊢ Class C ≤ T ⟹ ∃D. T=Class D ∧ P ⊢ C ≼⇧* D"
by (frule Class_widen, auto)
assume "is_type P a" "is_type P b" "is_type P c"
"subtype P a c" "subtype P b c" "sup P a b = OK d"
thus ?thesis
by (auto simp add: sup_def is_refT_def
split: if_split_asm)
qed
lemma sup_exists:
"⟦ subtype P a c; subtype P b c ⟧ ⟹ ∃T. sup P a b = OK T"
apply (unfold sup_def)
apply (cases b)
apply auto
apply (cases a)
apply auto
apply (cases a)
apply auto
done
lemma err_semilat_JType_esl:
"wf_prog wf_mb P ⟹ err_semilat (esl P)"
proof -
assume wf_prog: "wf_prog wf_mb P"
hence "order (subtype P)"..
moreover from wf_prog
have "closed (err (types P)) (lift2 (sup P))"
by (rule closed_err_types)
moreover
from wf_prog have
"(∀x∈err (types P). ∀y∈err (types P). x ⊑⇘Err.le (subtype P)⇙ x ⊔⇘lift2 (sup P)⇙ y) ∧
(∀x∈err (types P). ∀y∈err (types P). y ⊑⇘Err.le (subtype P)⇙ x ⊔⇘lift2 (sup P)⇙ y)"
by (auto simp add: lesub_def plussub_def Err.le_def lift2_def sup_subtype_greater split: err.split)
moreover from wf_prog have
"∀x∈err (types P). ∀y∈err (types P). ∀z∈err (types P).
x ⊑⇘Err.le (subtype P)⇙ z ∧ y ⊑⇘Err.le (subtype P)⇙ z ⟶ x ⊔⇘lift2 (sup P)⇙ y ⊑⇘Err.le (subtype P)⇙ z"
by (unfold lift2_def plussub_def lesub_def Err.le_def)
(auto intro: sup_subtype_smallest dest:sup_exists split: err.split)
ultimately show ?thesis by (simp add: esl_def semilat_def sl_def Err.sl_def)
qed
end
Theory JVM_SemiType
section ‹ The JVM Type System as Semilattice ›
theory JVM_SemiType imports SemiType begin
type_synonym ty⇩l = "ty err list"
type_synonym ty⇩s = "ty list"
type_synonym ty⇩i = "ty⇩s × ty⇩l"
type_synonym ty⇩i' = "ty⇩i option"
type_synonym ty⇩m = "ty⇩i' list"
type_synonym ty⇩P = "mname ⇒ cname ⇒ ty⇩m"
definition stk_esl :: "'c prog ⇒ nat ⇒ ty⇩s esl"
where
"stk_esl P mxs ≡ upto_esl mxs (SemiType.esl P)"
definition loc_sl :: "'c prog ⇒ nat ⇒ ty⇩l sl"
where
"loc_sl P mxl ≡ Listn.sl mxl (Err.sl (SemiType.esl P))"
definition sl :: "'c prog ⇒ nat ⇒ nat ⇒ ty⇩i' err sl"
where
"sl P mxs mxl ≡
Err.sl(Opt.esl(Product.esl (stk_esl P mxs) (Err.esl(loc_sl P mxl))))"
definition states :: "'c prog ⇒ nat ⇒ nat ⇒ ty⇩i' err set"
where "states P mxs mxl ≡ fst(sl P mxs mxl)"
definition le :: "'c prog ⇒ nat ⇒ nat ⇒ ty⇩i' err ord"
where
"le P mxs mxl ≡ fst(snd(sl P mxs mxl))"
definition sup :: "'c prog ⇒ nat ⇒ nat ⇒ ty⇩i' err binop"
where
"sup P mxs mxl ≡ snd(snd(sl P mxs mxl))"
definition sup_ty_opt :: "['c prog,ty err,ty err] ⇒ bool"
("_ ⊢ _ ≤⇩⊤ _" [71,71,71] 70)
where
"sup_ty_opt P ≡ Err.le (subtype P)"
definition sup_state :: "['c prog,ty⇩i,ty⇩i] ⇒ bool"
("_ ⊢ _ ≤⇩i _" [71,71,71] 70)
where
"sup_state P ≡ Product.le (Listn.le (subtype P)) (Listn.le (sup_ty_opt P))"
definition sup_state_opt :: "['c prog,ty⇩i',ty⇩i'] ⇒ bool"
("_ ⊢ _ ≤'' _" [71,71,71] 70)
where
"sup_state_opt P ≡ Opt.le (sup_state P)"
abbreviation
sup_loc :: "['c prog,ty⇩l,ty⇩l] ⇒ bool" ("_ ⊢ _ [≤⇩⊤] _" [71,71,71] 70)
where "P ⊢ LT [≤⇩⊤] LT' ≡ list_all2 (sup_ty_opt P) LT LT'"
notation (ASCII)
sup_ty_opt ("_ |- _ <=T _" [71,71,71] 70) and
sup_state ("_ |- _ <=i _" [71,71,71] 70) and
sup_state_opt ("_ |- _ <=' _" [71,71,71] 70) and
sup_loc ("_ |- _ [<=T] _" [71,71,71] 70)
subsection "Unfolding"
lemma JVM_states_unfold:
"states P mxs mxl ≡ err(opt((Union {list n (types P) |n. n <= mxs}) ×
list mxl (err(types P))))"
apply (unfold states_def sl_def Opt.esl_def Err.sl_def
stk_esl_def loc_sl_def Product.esl_def
Listn.sl_def upto_esl_def SemiType.esl_def Err.esl_def)
apply simp
done
lemma JVM_le_unfold:
"le P m n ≡
Err.le(Opt.le(Product.le(Listn.le(subtype P))(Listn.le(Err.le(subtype P)))))"
apply (unfold le_def sl_def Opt.esl_def Err.sl_def
stk_esl_def loc_sl_def Product.esl_def
Listn.sl_def upto_esl_def SemiType.esl_def Err.esl_def)
apply simp
done
lemma sl_def2:
"JVM_SemiType.sl P mxs mxl ≡
(states P mxs mxl, JVM_SemiType.le P mxs mxl, JVM_SemiType.sup P mxs mxl)"
by (unfold JVM_SemiType.sup_def states_def JVM_SemiType.le_def) simp
lemma JVM_le_conv:
"le P m n (OK t1) (OK t2) = P ⊢ t1 ≤' t2"
by (simp add: JVM_le_unfold Err.le_def lesub_def sup_state_opt_def
sup_state_def sup_ty_opt_def)
lemma JVM_le_Err_conv:
"le P m n = Err.le (sup_state_opt P)"
by (unfold sup_state_opt_def sup_state_def
sup_ty_opt_def JVM_le_unfold) simp
lemma err_le_unfold [iff]:
"Err.le r (OK a) (OK b) = r a b"
by (simp add: Err.le_def lesub_def)
subsection ‹ Semilattice ›
lemma order_sup_state_opt [intro, simp]:
"wf_prog wf_mb P ⟹ order (sup_state_opt P)"
by (unfold sup_state_opt_def sup_state_def sup_ty_opt_def) blast
lemma semilat_JVM [intro?]:
"wf_prog wf_mb P ⟹ semilat (JVM_SemiType.sl P mxs mxl)"
apply (unfold JVM_SemiType.sl_def stk_esl_def loc_sl_def)
apply (blast intro: err_semilat_Product_esl err_semilat_upto_esl
Listn_sl err_semilat_JType_esl)
done
lemma acc_JVM [intro]:
"wf_prog wf_mb P ⟹ acc (JVM_SemiType.le P mxs mxl)"
by (unfold JVM_le_unfold) blast
subsection ‹ Widening with @{text "⊤"} ›
lemma subtype_refl[iff]: "subtype P t t" by (simp add: fun_of_def)
lemma sup_ty_opt_refl [iff]: "P ⊢ T ≤⇩⊤ T"
apply (unfold sup_ty_opt_def)
apply (fold lesub_def)
apply (rule le_err_refl)
apply (simp add: lesub_def)
done
lemma Err_any_conv [iff]: "P ⊢ Err ≤⇩⊤ T = (T = Err)"
by (unfold sup_ty_opt_def) (rule Err_le_conv [simplified lesub_def])
lemma any_Err [iff]: "P ⊢ T ≤⇩⊤ Err"
by (unfold sup_ty_opt_def) (rule le_Err [simplified lesub_def])
lemma OK_OK_conv [iff]:
"P ⊢ OK T ≤⇩⊤ OK T' = P ⊢ T ≤ T'"
by (simp add: sup_ty_opt_def fun_of_def)
lemma any_OK_conv [iff]:
"P ⊢ X ≤⇩⊤ OK T' = (∃T. X = OK T ∧ P ⊢ T ≤ T')"
apply (unfold sup_ty_opt_def)
apply (rule le_OK_conv [simplified lesub_def])
done
lemma OK_any_conv:
"P ⊢ OK T ≤⇩⊤ X = (X = Err ∨ (∃T'. X = OK T' ∧ P ⊢ T ≤ T'))"
apply (unfold sup_ty_opt_def)
apply (rule OK_le_conv [simplified lesub_def])
done
lemma sup_ty_opt_trans [intro?, trans]:
"⟦P ⊢ a ≤⇩⊤ b; P ⊢ b ≤⇩⊤ c⟧ ⟹ P ⊢ a ≤⇩⊤ c"
by (auto intro: widen_trans
simp add: sup_ty_opt_def Err.le_def lesub_def fun_of_def
split: err.splits)
subsection "Stack and Registers"
lemma stk_convert:
"P ⊢ ST [≤] ST' = Listn.le (subtype P) ST ST'"
by (simp add: Listn.le_def lesub_def)
lemma sup_loc_refl [iff]: "P ⊢ LT [≤⇩⊤] LT"
by (rule list_all2_refl) simp
lemmas sup_loc_Cons1 [iff] = list_all2_Cons1 [of "sup_ty_opt P"] for P
lemma sup_loc_def:
"P ⊢ LT [≤⇩⊤] LT' ≡ Listn.le (sup_ty_opt P) LT LT'"
by (simp add: Listn.le_def lesub_def)
lemma sup_loc_widens_conv [iff]:
"P ⊢ map OK Ts [≤⇩⊤] map OK Ts' = P ⊢ Ts [≤] Ts'"
by (simp add: list_all2_map1 list_all2_map2)
lemma sup_loc_trans [intro?, trans]:
"⟦P ⊢ a [≤⇩⊤] b; P ⊢ b [≤⇩⊤] c⟧ ⟹ P ⊢ a [≤⇩⊤] c"
by (rule list_all2_trans, rule sup_ty_opt_trans)
subsection "State Type"
lemma sup_state_conv [iff]:
"P ⊢ (ST,LT) ≤⇩i (ST',LT') = (P ⊢ ST [≤] ST' ∧ P ⊢ LT [≤⇩⊤] LT')"
by (auto simp add: sup_state_def stk_convert lesub_def Product.le_def sup_loc_def)
lemma sup_state_conv2:
"P ⊢ s1 ≤⇩i s2 = (P ⊢ fst s1 [≤] fst s2 ∧ P ⊢ snd s1 [≤⇩⊤] snd s2)"
by (cases s1, cases s2) simp
lemma sup_state_refl [iff]: "P ⊢ s ≤⇩i s"
by (auto simp add: sup_state_conv2)
lemma sup_state_trans [intro?, trans]:
"⟦P ⊢ a ≤⇩i b; P ⊢ b ≤⇩i c⟧ ⟹ P ⊢ a ≤⇩i c"
by (auto intro: sup_loc_trans widens_trans simp add: sup_state_conv2)
lemma sup_state_opt_None_any [iff]:
"P ⊢ None ≤' s"
by (simp add: sup_state_opt_def Opt.le_def)
lemma sup_state_opt_any_None [iff]:
"P ⊢ s ≤' None = (s = None)"
by (simp add: sup_state_opt_def Opt.le_def)
lemma sup_state_opt_Some_Some [iff]:
"P ⊢ Some a ≤' Some b = P ⊢ a ≤⇩i b"
by (simp add: sup_state_opt_def Opt.le_def lesub_def)
lemma sup_state_opt_any_Some:
"P ⊢ (Some s) ≤' X = (∃s'. X = Some s' ∧ P ⊢ s ≤⇩i s')"
by (simp add: sup_state_opt_def Opt.le_def lesub_def)
lemma sup_state_opt_refl [iff]: "P ⊢ s ≤' s"
by (simp add: sup_state_opt_def Opt.le_def lesub_def)
lemma sup_state_opt_trans [intro?, trans]:
"⟦P ⊢ a ≤' b; P ⊢ b ≤' c⟧ ⟹ P ⊢ a ≤' c"
apply (unfold sup_state_opt_def Opt.le_def lesub_def)
apply (simp del: split_paired_All)
apply (rule sup_state_trans, assumption+)
done
end
Theory Effect
section ‹Effect of Instructions on the State Type›
theory Effect
imports JVM_SemiType "../JVM/JVMExceptions"
begin
locale prog =
fixes P :: "'a prog"
locale jvm_method = prog +
fixes mxs :: nat
fixes mxl⇩0 :: nat
fixes Ts :: "ty list"
fixes T⇩r :: ty
fixes "is" :: "instr list"
fixes xt :: ex_table
fixes mxl :: nat
defines mxl_def: "mxl ≡ 1+size Ts+mxl⇩0"
text ‹ Program counter of successor instructions: ›
primrec succs :: "instr ⇒ ty⇩i ⇒ pc ⇒ pc list" where
"succs (Load idx) τ pc = [pc+1]"
| "succs (Store idx) τ pc = [pc+1]"
| "succs (Push v) τ pc = [pc+1]"
| "succs (Getfield F C) τ pc = [pc+1]"
| "succs (Getstatic C F D) τ pc = [pc+1]"
| "succs (Putfield F C) τ pc = [pc+1]"
| "succs (Putstatic C F D) τ pc = [pc+1]"
| "succs (New C) τ pc = [pc+1]"
| "succs (Checkcast C) τ pc = [pc+1]"
| "succs Pop τ pc = [pc+1]"
| "succs IAdd τ pc = [pc+1]"
| "succs CmpEq τ pc = [pc+1]"
| succs_IfFalse:
"succs (IfFalse b) τ pc = [pc+1, nat (int pc + b)]"
| succs_Goto:
"succs (Goto b) τ pc = [nat (int pc + b)]"
| succs_Return:
"succs Return τ pc = []"
| succs_Invoke:
"succs (Invoke M n) τ pc = (if (fst τ)!n = NT then [] else [pc+1])"
| succs_Invokestatic:
"succs (Invokestatic C M n) τ pc = [pc+1]"
| succs_Throw:
"succs Throw τ pc = []"
text "Effect of instruction on the state type:"
fun the_class:: "ty ⇒ cname" where
"the_class (Class C) = C"
fun eff⇩i :: "instr × 'm prog × ty⇩i ⇒ ty⇩i" where
eff⇩i_Load:
"eff⇩i (Load n, P, (ST, LT)) = (ok_val (LT ! n) # ST, LT)"
| eff⇩i_Store:
"eff⇩i (Store n, P, (T#ST, LT)) = (ST, LT[n:= OK T])"
| eff⇩i_Push:
"eff⇩i (Push v, P, (ST, LT)) = (the (typeof v) # ST, LT)"
| eff⇩i_Getfield:
"eff⇩i (Getfield F C, P, (T#ST, LT)) = (snd (snd (field P C F)) # ST, LT)"
| eff⇩i_Getstatic:
"eff⇩i (Getstatic C F D, P, (ST, LT)) = (snd (snd (field P C F)) # ST, LT)"
| eff⇩i_Putfield:
"eff⇩i (Putfield F C, P, (T⇩1#T⇩2#ST, LT)) = (ST,LT)"
| eff⇩i_Putstatic:
"eff⇩i (Putstatic C F D, P, (T#ST, LT)) = (ST,LT)"
| eff⇩i_New:
"eff⇩i (New C, P, (ST,LT)) = (Class C # ST, LT)"
| eff⇩i_Checkcast:
"eff⇩i (Checkcast C, P, (T#ST,LT)) = (Class C # ST,LT)"
| eff⇩i_Pop:
"eff⇩i (Pop, P, (T#ST,LT)) = (ST,LT)"
| eff⇩i_IAdd:
"eff⇩i (IAdd, P,(T⇩1#T⇩2#ST,LT)) = (Integer#ST,LT)"
| eff⇩i_CmpEq:
"eff⇩i (CmpEq, P, (T⇩1#T⇩2#ST,LT)) = (Boolean#ST,LT)"
| eff⇩i_IfFalse:
"eff⇩i (IfFalse b, P, (T⇩1#ST,LT)) = (ST,LT)"
| eff⇩i_Invoke:
"eff⇩i (Invoke M n, P, (ST,LT)) =
(let C = the_class (ST!n); (D,b,Ts,T⇩r,m) = method P C M
in (T⇩r # drop (n+1) ST, LT))"
| eff⇩i_Invokestatic:
"eff⇩i (Invokestatic C M n, P, (ST,LT)) =
(let (D,b,Ts,T⇩r,m) = method P C M
in (T⇩r # drop n ST, LT))"
| eff⇩i_Goto:
"eff⇩i (Goto n, P, s) = s"
fun is_relevant_class :: "instr ⇒ 'm prog ⇒ cname ⇒ bool" where
rel_Getfield:
"is_relevant_class (Getfield F D)
= (λP C. P ⊢ NullPointer ≼⇧* C ∨ P ⊢ NoSuchFieldError ≼⇧* C
∨ P ⊢ IncompatibleClassChangeError ≼⇧* C)"
| rel_Getstatic:
"is_relevant_class (Getstatic C F D)
= (λP C. True)"
| rel_Putfield:
"is_relevant_class (Putfield F D)
= (λP C. P ⊢ NullPointer ≼⇧* C ∨ P ⊢ NoSuchFieldError ≼⇧* C
∨ P ⊢ IncompatibleClassChangeError ≼⇧* C)"
| rel_Putstatic:
"is_relevant_class (Putstatic C F D)
= (λP C. True)"
| rel_Checkcast:
"is_relevant_class (Checkcast D) = (λP C. P ⊢ ClassCast ≼⇧* C)"
| rel_New:
"is_relevant_class (New D) = (λP C. True)"
| rel_Throw:
"is_relevant_class Throw = (λP C. True)"
| rel_Invoke:
"is_relevant_class (Invoke M n) = (λP C. True)"
| rel_Invokestatic:
"is_relevant_class (Invokestatic C M n) = (λP C. True)"
| rel_default:
"is_relevant_class i = (λP C. False)"
definition is_relevant_entry :: "'m prog ⇒ instr ⇒ pc ⇒ ex_entry ⇒ bool" where
"is_relevant_entry P i pc e ⟷ (let (f,t,C,h,d) = e in is_relevant_class i P C ∧ pc ∈ {f..<t})"
definition relevant_entries :: "'m prog ⇒ instr ⇒ pc ⇒ ex_table ⇒ ex_table" where
"relevant_entries P i pc = filter (is_relevant_entry P i pc)"
definition xcpt_eff :: "instr ⇒ 'm prog ⇒ pc ⇒ ty⇩i
⇒ ex_table ⇒ (pc × ty⇩i') list" where
"xcpt_eff i P pc τ et = (let (ST,LT) = τ in
map (λ(f,t,C,h,d). (h, Some (Class C#drop (size ST - d) ST, LT))) (relevant_entries P i pc et))"
definition norm_eff :: "instr ⇒ 'm prog ⇒ nat ⇒ ty⇩i ⇒ (pc × ty⇩i') list" where
"norm_eff i P pc τ = map (λpc'. (pc',Some (eff⇩i (i,P,τ)))) (succs i τ pc)"
definition eff :: "instr ⇒ 'm prog ⇒ pc ⇒ ex_table ⇒ ty⇩i' ⇒ (pc × ty⇩i') list" where
"eff i P pc et t = (case t of
None ⇒ []
| Some τ ⇒ (norm_eff i P pc τ) @ (xcpt_eff i P pc τ et))"
lemma eff_None:
"eff i P pc xt None = []"
by (simp add: eff_def)
lemma eff_Some:
"eff i P pc xt (Some τ) = norm_eff i P pc τ @ xcpt_eff i P pc τ xt"
by (simp add: eff_def)
text "Conditions under which eff is applicable:"
fun app⇩i :: "instr × 'm prog × pc × nat × ty × ty⇩i ⇒ bool" where
app⇩i_Load:
"app⇩i (Load n, P, pc, mxs, T⇩r, (ST,LT)) =
(n < length LT ∧ LT ! n ≠ Err ∧ length ST < mxs)"
| app⇩i_Store:
"app⇩i (Store n, P, pc, mxs, T⇩r, (T#ST, LT)) =
(n < length LT)"
| app⇩i_Push:
"app⇩i (Push v, P, pc, mxs, T⇩r, (ST,LT)) =
(length ST < mxs ∧ typeof v ≠ None)"
| app⇩i_Getfield:
"app⇩i (Getfield F C, P, pc, mxs, T⇩r, (T#ST, LT)) =
(∃T⇩f. P ⊢ C sees F,NonStatic:T⇩f in C ∧ P ⊢ T ≤ Class C)"
| app⇩i_Getstatic:
"app⇩i (Getstatic C F D, P, pc, mxs, T⇩r, (ST, LT)) =
(length ST < mxs ∧ (∃T⇩f. P ⊢ C sees F,Static:T⇩f in D))"
| app⇩i_Putfield:
"app⇩i (Putfield F C, P, pc, mxs, T⇩r, (T⇩1#T⇩2#ST, LT)) =
(∃T⇩f. P ⊢ C sees F,NonStatic:T⇩f in C ∧ P ⊢ T⇩2 ≤ (Class C) ∧ P ⊢ T⇩1 ≤ T⇩f)"
| app⇩i_Putstatic:
"app⇩i (Putstatic C F D, P, pc, mxs, T⇩r, (T#ST, LT)) =
(∃T⇩f. P ⊢ C sees F,Static:T⇩f in D ∧ P ⊢ T ≤ T⇩f)"
| app⇩i_New:
"app⇩i (New C, P, pc, mxs, T⇩r, (ST,LT)) =
(is_class P C ∧ length ST < mxs)"
| app⇩i_Checkcast:
"app⇩i (Checkcast C, P, pc, mxs, T⇩r, (T#ST,LT)) =
(is_class P C ∧ is_refT T)"
| app⇩i_Pop:
"app⇩i (Pop, P, pc, mxs, T⇩r, (T#ST,LT)) =
True"
| app⇩i_IAdd:
"app⇩i (IAdd, P, pc, mxs, T⇩r, (T⇩1#T⇩2#ST,LT)) = (T⇩1 = T⇩2 ∧ T⇩1 = Integer)"
| app⇩i_CmpEq:
"app⇩i (CmpEq, P, pc, mxs, T⇩r, (T⇩1#T⇩2#ST,LT)) =
(T⇩1 = T⇩2 ∨ is_refT T⇩1 ∧ is_refT T⇩2)"
| app⇩i_IfFalse:
"app⇩i (IfFalse b, P, pc, mxs, T⇩r, (Boolean#ST,LT)) =
(0 ≤ int pc + b)"
| app⇩i_Goto:
"app⇩i (Goto b, P, pc, mxs, T⇩r, s) =
(0 ≤ int pc + b)"
| app⇩i_Return:
"app⇩i (Return, P, pc, mxs, T⇩r, (T#ST,LT)) =
(P ⊢ T ≤ T⇩r)"
| app⇩i_Throw:
"app⇩i (Throw, P, pc, mxs, T⇩r, (T#ST,LT)) =
is_refT T"
| app⇩i_Invoke:
"app⇩i (Invoke M n, P, pc, mxs, T⇩r, (ST,LT)) =
(n < length ST ∧
(ST!n ≠ NT ⟶
(∃C D Ts T m. ST!n = Class C ∧ P ⊢ C sees M,NonStatic:Ts → T = m in D ∧
P ⊢ rev (take n ST) [≤] Ts)))"
| app⇩i_Invokestatic:
"app⇩i (Invokestatic C M n, P, pc, mxs, T⇩r, (ST,LT)) =
(length ST - n < mxs ∧ n ≤ length ST ∧ M ≠ clinit ∧
(∃D Ts T m. P ⊢ C sees M,Static:Ts → T = m in D ∧
P ⊢ rev (take n ST) [≤] Ts))"
| app⇩i_default:
"app⇩i (i,P, pc,mxs,T⇩r,s) = False"
definition xcpt_app :: "instr ⇒ 'm prog ⇒ pc ⇒ nat ⇒ ex_table ⇒ ty⇩i ⇒ bool" where
"xcpt_app i P pc mxs xt τ ⟷ (∀(f,t,C,h,d) ∈ set (relevant_entries P i pc xt). is_class P C ∧ d ≤ size (fst τ) ∧ d < mxs)"
definition app :: "instr ⇒ 'm prog ⇒ nat ⇒ ty ⇒ nat ⇒ nat ⇒ ex_table ⇒ ty⇩i' ⇒ bool" where
"app i P mxs T⇩r pc mpc xt t = (case t of None ⇒ True | Some τ ⇒
app⇩i (i,P,pc,mxs,T⇩r,τ) ∧ xcpt_app i P pc mxs xt τ ∧
(∀(pc',τ') ∈ set (eff i P pc xt t). pc' < mpc))"
lemma app_Some:
"app i P mxs T⇩r pc mpc xt (Some τ) =
(app⇩i (i,P,pc,mxs,T⇩r,τ) ∧ xcpt_app i P pc mxs xt τ ∧
(∀(pc',s') ∈ set (eff i P pc xt (Some τ)). pc' < mpc))"
by (simp add: app_def)
locale eff = jvm_method +
fixes eff⇩i and app⇩i and eff and app
fixes norm_eff and xcpt_app and xcpt_eff
fixes mpc
defines "mpc ≡ size is"
defines "eff⇩i i τ ≡ Effect.eff⇩i (i,P,τ)"
notes eff⇩i_simps [simp] = Effect.eff⇩i.simps [where P = P, folded eff⇩i_def]
defines "app⇩i i pc τ ≡ Effect.app⇩i (i, P, pc, mxs, T⇩r, τ)"
notes app⇩i_simps [simp] = Effect.app⇩i.simps [where P=P and mxs=mxs and T⇩r=T⇩r, folded app⇩i_def]
defines "xcpt_eff i pc τ ≡ Effect.xcpt_eff i P pc τ xt"
notes xcpt_eff = Effect.xcpt_eff_def [of _ P _ _ xt, folded xcpt_eff_def]
defines "norm_eff i pc τ ≡ Effect.norm_eff i P pc τ"
notes norm_eff = Effect.norm_eff_def [of _ P, folded norm_eff_def eff⇩i_def]
defines "eff i pc ≡ Effect.eff i P pc xt"
notes eff = Effect.eff_def [of _ P _ xt, folded eff_def norm_eff_def xcpt_eff_def]
defines "xcpt_app i pc τ ≡ Effect.xcpt_app i P pc mxs xt τ"
notes xcpt_app = Effect.xcpt_app_def [of _ P _ mxs xt, folded xcpt_app_def]
defines "app i pc ≡ Effect.app i P mxs T⇩r pc mpc xt"
notes app = Effect.app_def [of _ P mxs T⇩r _ mpc xt, folded app_def xcpt_app_def app⇩i_def eff_def]
lemma length_cases2:
assumes "⋀LT. P ([],LT)"
assumes "⋀l ST LT. P (l#ST,LT)"
shows "P s"
by (cases s, cases "fst s") (auto intro!: assms)
lemma length_cases3:
assumes "⋀LT. P ([],LT)"
assumes "⋀l LT. P ([l],LT)"
assumes "⋀l ST LT. P (l#ST,LT)"
shows "P s"
proof -
obtain xs LT where s: "s = (xs,LT)" by (cases s)
show ?thesis
proof (cases xs)
case Nil with assms s show ?thesis by simp
next
fix l xs' assume "xs = l#xs'"
with assms s show ?thesis by simp
qed
qed
lemma length_cases4:
assumes "⋀LT. P ([],LT)"
assumes "⋀l LT. P ([l],LT)"
assumes "⋀l l' LT. P ([l,l'],LT)"
assumes "⋀l l' ST LT. P (l#l'#ST,LT)"
shows "P s"
proof -
obtain xs LT where s: "s = (xs,LT)" by (cases s)
show ?thesis
proof (cases xs)
case Nil with assms s show ?thesis by simp
next
fix l xs' assume xs: "xs = l#xs'"
thus ?thesis
proof (cases xs')
case Nil with assms s xs show ?thesis by simp
next
fix l' ST assume "xs' = l'#ST"
with assms s xs show ?thesis by simp
qed
qed
qed
text ‹
\medskip
simp rules for @{term app}
›
lemma appNone[simp]: "app i P mxs T⇩r pc mpc et None = True"
by (simp add: app_def)
lemma appLoad[simp]:
"app⇩i (Load idx, P, T⇩r, mxs, pc, s) = (∃ST LT. s = (ST,LT) ∧ idx < length LT ∧ LT!idx ≠ Err ∧ length ST < mxs)"
by (cases s, simp)
lemma appStore[simp]:
"app⇩i (Store idx,P,pc,mxs,T⇩r,s) = (∃ts ST LT. s = (ts#ST,LT) ∧ idx < length LT)"
by (rule length_cases2, auto)
lemma appPush[simp]:
"app⇩i (Push v,P,pc,mxs,T⇩r,s) =
(∃ST LT. s = (ST,LT) ∧ length ST < mxs ∧ typeof v ≠ None)"
by (cases s, simp)
lemma appGetField[simp]:
"app⇩i (Getfield F C,P,pc,mxs,T⇩r,s) =
(∃ oT vT ST LT. s = (oT#ST, LT) ∧
P ⊢ C sees F,NonStatic:vT in C ∧ P ⊢ oT ≤ (Class C))"
by (rule length_cases2 [of _ s]) auto
lemma appGetStatic[simp]:
"app⇩i (Getstatic C F D,P,pc,mxs,T⇩r,s) =
(∃ vT ST LT. s = (ST, LT) ∧ length ST < mxs ∧ P ⊢ C sees F,Static:vT in D)"
by (rule length_cases2 [of _ s]) auto
lemma appPutField[simp]:
"app⇩i (Putfield F C,P,pc,mxs,T⇩r,s) =
(∃ vT vT' oT ST LT. s = (vT#oT#ST, LT) ∧
P ⊢ C sees F,NonStatic:vT' in C ∧ P ⊢ oT ≤ (Class C) ∧ P ⊢ vT ≤ vT')"
by (rule length_cases4 [of _ s], auto)
lemma appPutstatic[simp]:
"app⇩i (Putstatic C F D,P,pc,mxs,T⇩r,s) =
(∃ vT vT' ST LT. s = (vT#ST, LT) ∧
P ⊢ C sees F,Static:vT' in D ∧ P ⊢ vT ≤ vT')"
by (rule length_cases4 [of _ s], auto)
lemma appNew[simp]:
"app⇩i (New C,P,pc,mxs,T⇩r,s) =
(∃ST LT. s=(ST,LT) ∧ is_class P C ∧ length ST < mxs)"
by (cases s, simp)
lemma appCheckcast[simp]:
"app⇩i (Checkcast C,P,pc,mxs,T⇩r,s) =
(∃T ST LT. s = (T#ST,LT) ∧ is_class P C ∧ is_refT T)"
by (cases s, cases "fst s", simp add: app_def) (cases "hd (fst s)", auto)
lemma app⇩iPop[simp]:
"app⇩i (Pop,P,pc,mxs,T⇩r,s) = (∃ts ST LT. s = (ts#ST,LT))"
by (rule length_cases2, auto)
lemma appIAdd[simp]:
"app⇩i (IAdd,P,pc,mxs,T⇩r,s) = (∃ST LT. s = (Integer#Integer#ST,LT))"
proof -
obtain ST LT where [simp]: "s = (ST,LT)" by (cases s)
have "ST = [] ∨ (∃T. ST = [T]) ∨ (∃T⇩1 T⇩2 ST'. ST = T⇩1#T⇩2#ST')"
by (cases ST, auto, case_tac list, auto)
moreover
{ assume "ST = []" hence ?thesis by simp }
moreover
{ fix T assume "ST = [T]" hence ?thesis by (cases T, auto) }
moreover
{ fix T⇩1 T⇩2 ST' assume "ST = T⇩1#T⇩2#ST'"
hence ?thesis by (cases T⇩1, auto)
}
ultimately show ?thesis by blast
qed
lemma appIfFalse [simp]:
"app⇩i (IfFalse b,P,pc,mxs,T⇩r,s) =
(∃ST LT. s = (Boolean#ST,LT) ∧ 0 ≤ int pc + b)"
apply (rule length_cases2)
apply simp
apply (case_tac l)
apply auto
done
lemma appCmpEq[simp]:
"app⇩i (CmpEq,P,pc,mxs,T⇩r,s) =
(∃T⇩1 T⇩2 ST LT. s = (T⇩1#T⇩2#ST,LT) ∧ (¬is_refT T⇩1 ∧ T⇩2 = T⇩1 ∨ is_refT T⇩1 ∧ is_refT T⇩2))"
by (rule length_cases4, auto)
lemma appReturn[simp]:
"app⇩i (Return,P,pc,mxs,T⇩r,s) = (∃T ST LT. s = (T#ST,LT) ∧ P ⊢ T ≤ T⇩r)"
by (rule length_cases2, auto)
lemma appThrow[simp]:
"app⇩i (Throw,P,pc,mxs,T⇩r,s) = (∃T ST LT. s=(T#ST,LT) ∧ is_refT T)"
by (rule length_cases2, auto)
lemma effNone:
"(pc', s') ∈ set (eff i P pc et None) ⟹ s' = None"
by (auto simp add: eff_def xcpt_eff_def norm_eff_def)
text ‹ some helpers to make the specification directly executable: ›
lemma relevant_entries_append [simp]:
"relevant_entries P i pc (xt @ xt') = relevant_entries P i pc xt @ relevant_entries P i pc xt'"
by (unfold relevant_entries_def) simp
lemma xcpt_app_append [iff]:
"xcpt_app i P pc mxs (xt@xt') τ = (xcpt_app i P pc mxs xt τ ∧ xcpt_app i P pc mxs xt' τ)"
by (unfold xcpt_app_def) fastforce
lemma xcpt_eff_append [simp]:
"xcpt_eff i P pc τ (xt@xt') = xcpt_eff i P pc τ xt @ xcpt_eff i P pc τ xt'"
by (unfold xcpt_eff_def, cases τ) simp
lemma app_append [simp]:
"app i P pc T mxs mpc (xt@xt') τ = (app i P pc T mxs mpc xt τ ∧ app i P pc T mxs mpc xt' τ)"
by (unfold app_def eff_def) auto
end
Theory EffectMono
section ‹ Monotonicity of eff and app ›
theory EffectMono imports Effect begin
declare not_Err_eq [iff]
lemma app⇩i_mono:
assumes wf: "wf_prog p P"
assumes less: "P ⊢ τ ≤⇩i τ'"
shows "app⇩i (i,P,mxs,mpc,rT,τ') ⟹ app⇩i (i,P,mxs,mpc,rT,τ)"
proof -
assume app: "app⇩i (i,P,mxs,mpc,rT,τ')"
obtain ST LT ST' LT' where
[simp]: "τ = (ST,LT)" and
[simp]: "τ' = (ST',LT')"
by (cases τ, cases τ')
from less have [simp]: "size ST = size ST'" and [simp]: "size LT = size LT'"
by (auto dest: list_all2_lengthD)
note [iff] = list_all2_Cons2 widen_Class
note [simp] = fun_of_def
from app less show "app⇩i (i,P,mxs,mpc,rT,τ)"
proof (cases i)
case Load
with app less show ?thesis by (auto dest!: list_all2_nthD)
next
case (Invoke M n)
with app have n: "n < size ST'" by simp
{ assume "ST!n = NT" hence ?thesis using n app Invoke by simp }
moreover {
assume "ST'!n = NT"
moreover with n less have "ST!n = NT"
by (auto dest: list_all2_nthD)
ultimately have ?thesis using n app Invoke by simp
}
moreover {
assume ST: "ST!n ≠ NT" and ST': "ST'!n ≠ NT"
from ST' app Invoke obtain D Ts T m C' where
D: "ST' ! n = Class D" and
Ts: "P ⊢ rev (take n ST') [≤] Ts" and
D_M: "P ⊢ D sees M,NonStatic: Ts→T = m in C'"
by auto
from n D less have "P ⊢ ST!n ≤ ST'!n"
by (fastforce dest: list_all2_nthD2)
with D ST obtain D' where
D': "ST!n = Class D'" and DsubC: "P ⊢ D' ≼⇧* D" by auto
from wf D_M DsubC obtain Ts' T' m' C'' where
D'_M: "P ⊢ D' sees M,NonStatic: Ts'→T' = m' in C''" and
Ts': "P ⊢ Ts [≤] Ts'"
by (blast dest: sees_method_mono)
from less have "P ⊢ rev (take n ST) [≤] rev (take n ST')" by simp
also note Ts also note Ts'
finally have "P ⊢ rev (take n ST) [≤] Ts'" .
with D'_M D' app less Invoke have ?thesis by fastforce
}
ultimately show ?thesis by blast
next
case (Invokestatic D M n)
moreover {
from app Invokestatic obtain Ts T m C' where
Ts: "P ⊢ rev (take n ST') [≤] Ts" and
D_M: "P ⊢ D sees M,Static: Ts→T = m in C'"
by auto
from wf D_M obtain Ts' T' m' C'' where
D'_M: "P ⊢ D sees M,Static: Ts'→T' = m' in C''" and
Ts': "P ⊢ Ts [≤] Ts'"
by (blast dest: sees_method_mono)
from less have "P ⊢ rev (take n ST) [≤] rev (take n ST')" by simp
also note Ts also note Ts'
finally have "P ⊢ rev (take n ST) [≤] Ts'" .
with D'_M app less Invokestatic have ?thesis by fastforce
}
ultimately show ?thesis by blast
next
case Getfield
with app less show ?thesis by (fastforce intro: rtrancl_trans)
next
case (Putfield F C)
with app less show ?thesis by (fastforce intro: widen_trans rtrancl_trans)
next
case (Putstatic C F D)
with app less show ?thesis by (fastforce intro: widen_trans rtrancl_trans)
next
case Return
with app less show ?thesis by (fastforce intro: widen_trans)
qed (auto elim!: refTE not_refTE)
qed
lemma succs_mono:
assumes wf: "wf_prog p P" and app⇩i: "app⇩i (i,P,mxs,mpc,rT,τ')"
shows "P ⊢ τ ≤⇩i τ' ⟹ set (succs i τ pc) ⊆ set (succs i τ' pc)"
proof (cases i)
case (Invoke M n)
obtain ST LT ST' LT' where
[simp]: "τ = (ST,LT)" and [simp]: "τ' = (ST',LT')" by (cases τ, cases τ')
assume "P ⊢ τ ≤⇩i τ'"
moreover
with app⇩i Invoke have "n < size ST" by (auto dest: list_all2_lengthD)
ultimately
have "P ⊢ ST!n ≤ ST'!n" by (auto simp add: fun_of_def dest: list_all2_nthD)
with Invoke show ?thesis by auto
qed auto
lemma app_mono:
assumes wf: "wf_prog p P"
assumes less': "P ⊢ τ ≤' τ'"
shows "app i P m rT pc mpc xt τ' ⟹ app i P m rT pc mpc xt τ"
proof (cases τ)
case None thus ?thesis by simp
next
case (Some τ⇩1)
moreover
with less' obtain τ⇩2 where τ⇩2: "τ' = Some τ⇩2" by (cases τ') auto
ultimately have less: "P ⊢ τ⇩1 ≤⇩i τ⇩2" using less' by simp
assume "app i P m rT pc mpc xt τ'"
with Some τ⇩2 obtain
app⇩i: "app⇩i (i, P, pc, m, rT, τ⇩2)" and
xcpt: "xcpt_app i P pc m xt τ⇩2" and
succs: "∀(pc',s')∈set (eff i P pc xt (Some τ⇩2)). pc' < mpc"
by (auto simp add: app_def)
from wf less app⇩i have "app⇩i (i, P, pc, m, rT, τ⇩1)" by (rule app⇩i_mono)
moreover
from less have "size (fst τ⇩1) = size (fst τ⇩2)"
by (cases τ⇩1, cases τ⇩2) (auto dest: list_all2_lengthD)
with xcpt have "xcpt_app i P pc m xt τ⇩1" by (simp add: xcpt_app_def)
moreover
from wf app⇩i less have "∀pc. set (succs i τ⇩1 pc) ⊆ set (succs i τ⇩2 pc)"
by (blast dest: succs_mono)
with succs
have "∀(pc',s')∈set (eff i P pc xt (Some τ⇩1)). pc' < mpc"
by (cases τ⇩1, cases τ⇩2)
(auto simp add: eff_def norm_eff_def xcpt_eff_def dest: bspec)
ultimately
show ?thesis using Some by (simp add: app_def)
qed
lemma eff⇩i_mono:
assumes wf: "wf_prog p P"
assumes less: "P ⊢ τ ≤⇩i τ'"
assumes app⇩i: "app i P m rT pc mpc xt (Some τ')"
assumes succs: "succs i τ pc ≠ []" "succs i τ' pc ≠ []"
shows "P ⊢ eff⇩i (i,P,τ) ≤⇩i eff⇩i (i,P,τ')"
proof -
obtain ST LT ST' LT' where
[simp]: "τ = (ST,LT)" and
[simp]: "τ' = (ST',LT')"
by (cases τ, cases τ')
note [simp] = eff_def app_def fun_of_def
from less have "P ⊢ (Some τ) ≤' (Some τ')" by simp
from wf this app⇩i
have app: "app i P m rT pc mpc xt (Some τ)" by (rule app_mono)
from less app app⇩i show ?thesis
proof (cases i)
case Throw with succs have False by simp
thus ?thesis ..
next
case Return with succs have False by simp
thus ?thesis ..
next
case (Load i)
from Load app obtain y where
y: "i < size LT" "LT!i = OK y" by clarsimp
from Load app⇩i obtain y' where
y': "i < size LT'" "LT'!i = OK y'" by clarsimp
from less have "P ⊢ LT [≤⇩⊤] LT'" by simp
with y y' have "P ⊢ y ≤ y'" by (auto dest: list_all2_nthD)
with Load less y y' app app⇩i
show ?thesis by auto
next
case Store with less app app⇩i
show ?thesis by (auto simp add: list_all2_update_cong)
next
case (Invoke M n)
with app⇩i have n: "n < size ST'" by simp
from less have [simp]: "size ST = size ST'"
by (auto dest: list_all2_lengthD)
from Invoke succs have ST: "ST!n ≠ NT" and ST': "ST'!n ≠ NT"
by (auto split: if_split_asm)
from ST' app⇩i Invoke obtain D Ts T m C' where
D: "ST' ! n = Class D" and
D_M: "P ⊢ D sees M,NonStatic: Ts→T = m in C'"
by auto
from n D less have "P ⊢ ST!n ≤ ST'!n"
by (fastforce dest: list_all2_nthD2)
with D ST obtain D' where
D': "ST ! n = Class D'" and DsubC: "P ⊢ D' ≼⇧* D"
by (auto simp: widen_Class)
from wf D_M DsubC obtain Ts' T' m' C'' where
D'_M: "P ⊢ D' sees M,NonStatic: Ts'→T' = m' in C''" and
Ts': "P ⊢ T' ≤ T"
by (blast dest: sees_method_mono)
with Invoke n D D' D_M less
show ?thesis by (auto intro: list_all2_dropI)
qed auto
qed
end
Theory BVSpec
section ‹ The Bytecode Verifier \label{sec:BVSpec} ›
theory BVSpec
imports Effect
begin
text ‹
This theory contains a specification of the BV. The specification
describes correct typings of method bodies; it corresponds
to type \emph{checking}.
›
definition
check_types :: "'m prog ⇒ nat ⇒ nat ⇒ ty⇩i' err list ⇒ bool"
where
"check_types P mxs mxl τs ≡ set τs ⊆ states P mxs mxl"
definition
wt_instr :: "['m prog,ty,nat,pc,ex_table,instr,pc,ty⇩m] ⇒ bool"
("_,_,_,_,_ ⊢ _,_ :: _" [60,0,0,0,0,0,0,61] 60)
where
"P,T,mxs,mpc,xt ⊢ i,pc :: τs ≡
app i P mxs T pc mpc xt (τs!pc) ∧
(∀(pc',τ') ∈ set (eff i P pc xt (τs!pc)). P ⊢ τ' ≤' τs!pc')"
definition wt_start :: "['m prog,cname,staticb,ty list,nat,ty⇩m] ⇒ bool"
where
"wt_start P C b Ts mxl⇩0 τs ≡
case b of NonStatic ⇒ P ⊢ Some ([],OK (Class C)#map OK Ts@replicate mxl⇩0 Err) ≤' τs!0
| Static ⇒ P ⊢ Some ([],map OK Ts@replicate mxl⇩0 Err) ≤' τs!0"
definition wt_method :: "['m prog,cname,staticb,ty list,ty,nat,nat,instr list,
ex_table,ty⇩m] ⇒ bool"
where
"wt_method P C b Ts T⇩r mxs mxl⇩0 is xt τs ≡
0 < size is ∧ size τs = size is ∧
check_types P mxs ((case b of Static ⇒ 0 | NonStatic ⇒ 1)+size Ts+mxl⇩0) (map OK τs) ∧
wt_start P C b Ts mxl⇩0 τs ∧
(∀pc < size is. P,T⇩r,mxs,size is,xt ⊢ is!pc,pc :: τs)"
definition wf_jvm_prog_phi :: "ty⇩P ⇒ jvm_prog ⇒ bool" ("wf'_jvm'_prog⇘_⇙")
where
"wf_jvm_prog⇘Φ⇙ ≡
wf_prog (λP C (M,b,Ts,T⇩r,(mxs,mxl⇩0,is,xt)).
wt_method P C b Ts T⇩r mxs mxl⇩0 is xt (Φ C M))"
definition wf_jvm_prog :: "jvm_prog ⇒ bool"
where
"wf_jvm_prog P ≡ ∃Φ. wf_jvm_prog⇘Φ⇙ P"
lemma wt_jvm_progD:
"wf_jvm_prog⇘Φ⇙ P ⟹ ∃wt. wf_prog wt P"
by (unfold wf_jvm_prog_phi_def, blast)
lemma wt_jvm_prog_impl_wt_instr:
"⟦ wf_jvm_prog⇘Φ⇙ P;
P ⊢ C sees M,b:Ts → T = (mxs,mxl⇩0,ins,xt) in C; pc < size ins ⟧
⟹ P,T,mxs,size ins,xt ⊢ ins!pc,pc :: Φ C M"
apply (unfold wf_jvm_prog_phi_def)
apply (drule (1) sees_wf_mdecl)
apply (simp add: wf_mdecl_def wt_method_def)
done
lemma wt_jvm_prog_impl_wt_start:
"⟦ wf_jvm_prog⇘Φ⇙ P;
P ⊢ C sees M,b:Ts → T = (mxs,mxl⇩0,ins,xt) in C ⟧ ⟹
0 < size ins ∧ wt_start P C b Ts mxl⇩0 (Φ C M)"
apply (unfold wf_jvm_prog_phi_def)
apply (drule (1) sees_wf_mdecl)
apply (simp add: wf_mdecl_def wt_method_def)
done
lemma wf_jvm_prog_nclinit:
assumes wtp: "wf_jvm_prog⇘Φ⇙ P"
and meth: "P ⊢ C sees M, b : Ts→T = (mxs, mxl⇩0, ins, xt) in D"
and wt: "P,T,mxs,size ins,xt ⊢ ins!pc,pc :: Φ C M"
and pc: "pc < length ins" and Φ: "Φ C M ! pc = Some(ST,LT)"
and ins: "ins ! pc = Invokestatic C⇩0 M⇩0 n"
shows "M⇩0 ≠ clinit"
using assms by(simp add: wf_jvm_prog_phi_def wt_instr_def app_def)
end
Theory TF_JVM
section ‹ The Typing Framework for the JVM \label{sec:JVM} ›
theory TF_JVM
imports Jinja.Typing_Framework_err EffectMono BVSpec
begin
definition exec :: "jvm_prog ⇒ nat ⇒ ty ⇒ ex_table ⇒ instr list ⇒ ty⇩i' err step_type"
where
"exec G maxs rT et bs ≡
err_step (size bs) (λpc. app (bs!pc) G maxs rT pc (size bs) et)
(λpc. eff (bs!pc) G pc et)"
locale JVM_sl =
fixes P :: jvm_prog and mxs and mxl⇩0
fixes b and Ts :: "ty list" and "is" and xt and T⇩r
fixes mxl and A and r and f and app and eff and step
defines [simp]: "mxl ≡ (case b of Static ⇒ 0 | NonStatic ⇒ 1)+size Ts+mxl⇩0"
defines [simp]: "A ≡ states P mxs mxl"
defines [simp]: "r ≡ JVM_SemiType.le P mxs mxl"
defines [simp]: "f ≡ JVM_SemiType.sup P mxs mxl"
defines [simp]: "app ≡ λpc. Effect.app (is!pc) P mxs T⇩r pc (size is) xt"
defines [simp]: "eff ≡ λpc. Effect.eff (is!pc) P pc xt"
defines [simp]: "step ≡ err_step (size is) app eff"
locale start_context = JVM_sl +
fixes p and C
assumes wf: "wf_prog p P"
assumes C: "is_class P C"
assumes Ts: "set Ts ⊆ types P"
fixes first :: ty⇩i' and start
defines [simp]:
"first ≡ Some ([],(case b of Static ⇒ [] | NonStatic ⇒ [OK (Class C)]) @ map OK Ts @ replicate mxl⇩0 Err)"
defines [simp]:
"start ≡ (OK first) # replicate (size is - 1) (OK None)"
subsection ‹ Connecting JVM and Framework ›
lemma (in JVM_sl) step_def_exec: "step ≡ exec P mxs T⇩r xt is"
by (simp add: exec_def)
lemma special_ex_swap_lemma [iff]:
"(? X. (? n. X = A n & P n) & Q X) = (? n. Q(A n) & P n)"
by blast
lemma ex_in_list [iff]:
"(∃n. ST ∈ list n A ∧ n ≤ mxs) = (set ST ⊆ A ∧ size ST ≤ mxs)"
by (unfold list_def) auto
lemma singleton_list:
"(∃n. [Class C] ∈ list n (types P) ∧ n ≤ mxs) = (is_class P C ∧ 0 < mxs)"
by auto
lemma set_drop_subset:
"set xs ⊆ A ⟹ set (drop n xs) ⊆ A"
by (auto dest: in_set_dropD)
lemma Suc_minus_minus_le:
"n < mxs ⟹ Suc (n - (n - b)) ≤ mxs"
by arith
lemma in_listE:
"⟦ xs ∈ list n A; ⟦size xs = n; set xs ⊆ A⟧ ⟹ P ⟧ ⟹ P"
by (unfold list_def) blast
declare is_relevant_entry_def [simp]
declare set_drop_subset [simp]
theorem (in start_context) exec_pres_type:
"pres_type step (size is) A"
apply (insert wf)
apply simp
apply (unfold JVM_states_unfold)
apply (rule pres_type_lift)
apply clarify
apply (rename_tac s pc pc' s')
apply (case_tac s)
apply simp
apply (drule effNone)
apply simp
apply (simp add: Effect.app_def xcpt_app_def Effect.eff_def
xcpt_eff_def norm_eff_def relevant_entries_def)
apply (case_tac "is!pc")
apply clarsimp
apply (frule listE_nth_in, assumption)
apply fastforce
apply fastforce
apply (fastforce simp add: typeof_lit_is_type)
apply fastforce
apply (fastforce dest: sees_field_is_type)
apply (fastforce dest: sees_field_is_type)
apply fastforce
apply fastforce
apply fastforce
defer defer
apply fastforce
apply fastforce
apply fastforce
apply fastforce
apply fastforce
apply fastforce
apply fastforce
apply (clarsimp split!: if_splits)
apply fastforce
apply (erule disjE)
prefer 2
apply fastforce
apply clarsimp
apply (rule conjI)
apply (drule (1) sees_wf_mdecl)
apply (clarsimp simp add: wf_mdecl_def)
apply arith
apply (clarsimp split!: if_splits)
apply (erule disjE)
prefer 2
apply fastforce
apply clarsimp
apply (drule (1) sees_wf_mdecl)
apply (clarsimp simp add: wf_mdecl_def)
done
declare is_relevant_entry_def [simp del]
declare set_drop_subset [simp del]
lemma lesubstep_type_simple:
"xs [⊑⇘Product.le (=) r⇙] ys ⟹ set xs {⊑⇘r⇙} set ys"
apply (unfold lesubstep_type_def)
apply clarify
apply (simp add: set_conv_nth)
apply clarify
apply (drule le_listD, assumption)
apply (clarsimp simp add: lesub_def Product.le_def)
apply (rule exI)
apply (rule conjI)
apply (rule exI)
apply (rule conjI)
apply (rule sym)
apply assumption
apply assumption
apply assumption
done
declare is_relevant_entry_def [simp del]
lemma conjI2: "⟦ A; A ⟹ B ⟧ ⟹ A ∧ B" by blast
lemma (in JVM_sl) eff_mono:
"⟦wf_prog p P; pc < length is; s ⊑⇘sup_state_opt P⇙ t; app pc t⟧
⟹ set (eff pc s) {⊑⇘sup_state_opt P⇙} set (eff pc t)"
apply simp
apply (unfold Effect.eff_def)
apply (cases t)
apply (simp add: lesub_def)
apply (rename_tac a)
apply (cases s)
apply simp
apply (rename_tac b)
apply simp
apply (rule lesubstep_union)
prefer 2
apply (rule lesubstep_type_simple)
apply (simp add: xcpt_eff_def)
apply (rule le_listI)
apply (simp add: split_beta)
apply (simp add: split_beta)
apply (simp add: lesub_def fun_of_def)
apply (case_tac a)
apply (case_tac b)
apply simp
apply (subgoal_tac "size ab = size aa")
prefer 2
apply (clarsimp simp add: list_all2_lengthD)
apply simp
apply (clarsimp simp add: norm_eff_def lesubstep_type_def lesub_def iff del: sup_state_conv)
apply (rule exI)
apply (rule conjI2)
apply (rule imageI)
apply (clarsimp simp add: Effect.app_def iff del: sup_state_conv)
apply (drule (2) succs_mono)
apply blast
apply simp
apply (erule eff⇩i_mono)
apply simp
apply assumption
apply clarsimp
apply clarsimp
done
lemma (in JVM_sl) bounded_step: "bounded step (size is)"
apply simp
apply (unfold bounded_def err_step_def Effect.app_def Effect.eff_def)
apply (auto simp add: error_def map_snd_def split: err.splits option.splits)
done
theorem (in JVM_sl) step_mono:
"wf_prog wf_mb P ⟹ mono r step (size is) A"
apply (simp add: JVM_le_Err_conv)
apply (insert bounded_step)
apply (unfold JVM_states_unfold)
apply (rule mono_lift)
apply blast
apply (unfold app_mono_def lesub_def)
apply clarsimp
apply (erule (2) app_mono)
apply simp
apply clarify
apply (drule eff_mono)
apply (auto simp add: lesub_def)
done
lemma (in start_context) first_in_A [iff]: "OK first ∈ A"
using Ts C by (cases b; force intro!: list_appendI simp add: JVM_states_unfold)
lemma (in JVM_sl) wt_method_def2:
"wt_method P C' b Ts T⇩r mxs mxl⇩0 is xt τs =
(is ≠ [] ∧
size τs = size is ∧
OK ` set τs ⊆ states P mxs mxl ∧
wt_start P C' b Ts mxl⇩0 τs ∧
wt_app_eff (sup_state_opt P) app eff τs)"
apply (unfold wt_method_def wt_app_eff_def wt_instr_def lesub_def check_types_def)
apply auto
done
end
Theory BVExec
section ‹ Kildall for the JVM \label{sec:JVM} ›
theory BVExec
imports Jinja.Abstract_BV TF_JVM
begin
definition kiljvm :: "jvm_prog ⇒ nat ⇒ nat ⇒ ty ⇒
instr list ⇒ ex_table ⇒ ty⇩i' err list ⇒ ty⇩i' err list"
where
"kiljvm P mxs mxl T⇩r is xt ≡
kildall (JVM_SemiType.le P mxs mxl) (JVM_SemiType.sup P mxs mxl)
(exec P mxs T⇩r xt is)"
definition wt_kildall :: "jvm_prog ⇒ cname ⇒ staticb ⇒ ty list ⇒ ty ⇒ nat ⇒ nat ⇒
instr list ⇒ ex_table ⇒ bool"
where
"wt_kildall P C' b Ts T⇩r mxs mxl⇩0 is xt ≡
0 < size is ∧
(let first = Some ([],(case b of Static ⇒ [] | NonStatic ⇒ [OK (Class C')])
@(map OK Ts)@(replicate mxl⇩0 Err));
start = (OK first)#(replicate (size is - 1) (OK None));
result = kiljvm P mxs
((case b of Static ⇒ 0 | NonStatic ⇒ 1)+size Ts+mxl⇩0)
T⇩r is xt start
in ∀n < size is. result!n ≠ Err)"
definition wf_jvm_prog⇩k :: "jvm_prog ⇒ bool"
where
"wf_jvm_prog⇩k P ≡
wf_prog (λP C' (M,b,Ts,T⇩r,(mxs,mxl⇩0,is,xt)). wt_kildall P C' b Ts T⇩r mxs mxl⇩0 is xt) P"
theorem (in start_context) is_bcv_kiljvm:
"is_bcv r Err step (size is) A (kiljvm P mxs mxl T⇩r is xt)"
apply (insert wf)
apply (unfold kiljvm_def)
apply (fold r_def f_def step_def_exec)
apply (rule is_bcv_kildall)
apply simp apply (rule Semilat.intro)
apply (fold sl_def2)
apply (erule semilat_JVM)
apply simp
apply blast
apply (simp add: JVM_le_unfold)
apply (rule exec_pres_type)
apply (rule bounded_step)
apply (erule step_mono)
done
lemma subset_replicate [intro?]: "set (replicate n x) ⊆ {x}"
by (induct n) auto
lemma in_set_replicate:
assumes "x ∈ set (replicate n y)"
shows "x = y"
proof -
note assms
also have "set (replicate n y) ⊆ {y}" ..
finally show ?thesis by simp
qed
lemma (in start_context) start_in_A [intro?]:
"0 < size is ⟹ start ∈ list (size is) A"
using Ts C
apply (simp add: JVM_states_unfold)
apply (cases b; force intro!: listI list_appendI dest!: in_set_replicate)
done
theorem (in start_context) wt_kil_correct:
assumes wtk: "wt_kildall P C b Ts T⇩r mxs mxl⇩0 is xt"
shows "∃τs. wt_method P C b Ts T⇩r mxs mxl⇩0 is xt τs"
proof -
from wtk obtain res where
result: "res = kiljvm P mxs mxl T⇩r is xt start" and
success: "∀n < size is. res!n ≠ Err" and
instrs: "0 < size is"
by (unfold wt_kildall_def) simp
have bcv: "is_bcv r Err step (size is) A (kiljvm P mxs mxl T⇩r is xt)"
by (rule is_bcv_kiljvm)
from instrs have "start ∈ list (size is) A" ..
with bcv success result have
"∃ts∈list (size is) A. start [⊑⇩r] ts ∧ wt_step r Err step ts"
by (unfold is_bcv_def) blast
then obtain τs' where
in_A: "τs' ∈ list (size is) A" and
s: "start [⊑⇩r] τs'" and
w: "wt_step r Err step τs'"
by blast
hence wt_err_step: "wt_err_step (sup_state_opt P) step τs'"
by (simp add: wt_err_step_def JVM_le_Err_conv)
from in_A have l: "size τs' = size is" by simp
moreover {
from in_A have "check_types P mxs mxl τs'" by (simp add: check_types_def)
also from w have "∀x ∈ set τs'. x ≠ Err"
by (auto simp add: wt_step_def all_set_conv_all_nth)
hence [symmetric]: "map OK (map ok_val τs') = τs'"
by (auto intro!: map_idI simp add: wt_step_def)
finally have "check_types P mxs mxl (map OK (map ok_val τs'))" .
}
moreover {
from s have "start!0 ⊑⇩r τs'!0" by (rule le_listD) simp
moreover
from instrs w l
have "τs'!0 ≠ Err" by (unfold wt_step_def) simp
then obtain τs0 where "τs'!0 = OK τs0" by auto
ultimately
have "wt_start P C b Ts mxl⇩0 (map ok_val τs')" using l instrs
by (unfold wt_start_def)
(cases b; simp add: lesub_def JVM_le_Err_conv Err.le_def)
}
moreover
from in_A have "set τs' ⊆ A" by simp
with wt_err_step bounded_step
have "wt_app_eff (sup_state_opt P) app eff (map ok_val τs')"
by (auto intro: wt_err_imp_wt_app_eff simp add: l)
ultimately
have "wt_method P C b Ts T⇩r mxs mxl⇩0 is xt (map ok_val τs')"
using instrs by (simp add: wt_method_def2 check_types_def del: map_map)
thus ?thesis by blast
qed
theorem (in start_context) wt_kil_complete:
assumes wtm: "wt_method P C b Ts T⇩r mxs mxl⇩0 is xt τs"
shows "wt_kildall P C b Ts T⇩r mxs mxl⇩0 is xt"
proof -
from wtm obtain
instrs: "0 < size is" and
length: "length τs = length is" and
ck_type: "check_types P mxs mxl (map OK τs)" and
wt_start: "wt_start P C b Ts mxl⇩0 τs" and
app_eff: "wt_app_eff (sup_state_opt P) app eff τs"
by (simp add: wt_method_def2 check_types_def)
from ck_type
have in_A: "set (map OK τs) ⊆ A"
by (simp add: check_types_def)
with app_eff in_A bounded_step
have "wt_err_step (sup_state_opt P) (err_step (size τs) app eff) (map OK τs)"
by - (erule wt_app_eff_imp_wt_err,
auto simp add: exec_def length states_def)
hence wt_err: "wt_err_step (sup_state_opt P) step (map OK τs)"
by (simp add: length)
have is_bcv: "is_bcv r Err step (size is) A (kiljvm P mxs mxl T⇩r is xt)"
by (rule is_bcv_kiljvm)
moreover from instrs have "start ∈ list (size is) A" ..
moreover
let ?τs = "map OK τs"
have less_τs: "start [⊑⇩r] ?τs"
proof (rule le_listI)
from length instrs
show "length start = length (map OK τs)" by simp
next
fix n
from wt_start have "P ⊢ ok_val (start!0) ≤' τs!0"
by (cases b; simp add: wt_start_def)
moreover from instrs length have "0 < length τs" by simp
ultimately have "start!0 ⊑⇩r ?τs!0"
by (simp add: JVM_le_Err_conv lesub_def)
moreover {
fix n'
have "OK None ⊑⇩r ?τs!n"
by (auto simp add: JVM_le_Err_conv Err.le_def lesub_def
split: err.splits)
hence "⟦n = Suc n'; n < size start⟧ ⟹ start!n ⊑⇩r ?τs!n" by simp
}
ultimately
show "n < size start ⟹ start!n ⊑⇩r ?τs!n" by (cases n, blast+)
qed
moreover
from ck_type length
have "?τs ∈ list (size is) A"
by (auto intro!: listI simp add: check_types_def)
moreover
from wt_err have "wt_step r Err step ?τs"
by (simp add: wt_err_step_def JVM_le_Err_conv)
ultimately
have "∀p. p < size is ⟶ kiljvm P mxs mxl T⇩r is xt start ! p ≠ Err"
by (unfold is_bcv_def) blast
with instrs
show "wt_kildall P C b Ts T⇩r mxs mxl⇩0 is xt" by (unfold wt_kildall_def) simp
qed
theorem jvm_kildall_correct:
"wf_jvm_prog⇩k P = wf_jvm_prog P"
proof
let ?Φ = "λC M. let (C,b,Ts,T⇩r,(mxs,mxl⇩0,is,xt)) = method P C M in
SOME τs. wt_method P C b Ts T⇩r mxs mxl⇩0 is xt τs"
assume wt: "wf_jvm_prog⇩k P"
hence "wf_jvm_prog⇘?Φ⇙ P"
apply (unfold wf_jvm_prog_phi_def wf_jvm_prog⇩k_def)
apply (erule wf_prog_lift)
apply (auto dest!: start_context.wt_kil_correct [OF start_context.intro]
intro: someI)
apply (erule sees_method_is_class)
done
thus "wf_jvm_prog P" by (unfold wf_jvm_prog_def) fast
next
assume wt: "wf_jvm_prog P"
thus "wf_jvm_prog⇩k P"
apply (unfold wf_jvm_prog_def wf_jvm_prog_phi_def wf_jvm_prog⇩k_def)
apply (clarify)
apply (erule wf_prog_lift)
apply (auto intro!: start_context.wt_kil_complete start_context.intro)
apply (erule sees_method_is_class)
done
qed
end
Theory LBVJVM
section ‹ LBV for the JVM \label{sec:JVM} ›
theory LBVJVM
imports Jinja.Abstract_BV TF_JVM
begin
type_synonym prog_cert = "cname ⇒ mname ⇒ ty⇩i' err list"
definition check_cert :: "jvm_prog ⇒ nat ⇒ nat ⇒ nat ⇒ ty⇩i' err list ⇒ bool"
where
"check_cert P mxs mxl n cert ≡ check_types P mxs mxl cert ∧ size cert = n+1 ∧
(∀i<n. cert!i ≠ Err) ∧ cert!n = OK None"
definition lbvjvm :: "jvm_prog ⇒ nat ⇒ nat ⇒ ty ⇒ ex_table ⇒
ty⇩i' err list ⇒ instr list ⇒ ty⇩i' err ⇒ ty⇩i' err"
where
"lbvjvm P mxs maxr T⇩r et cert bs ≡
wtl_inst_list bs cert (JVM_SemiType.sup P mxs maxr) (JVM_SemiType.le P mxs maxr) Err (OK None) (exec P mxs T⇩r et bs) 0"
definition wt_lbv :: "jvm_prog ⇒ cname ⇒ staticb ⇒ ty list ⇒ ty ⇒ nat ⇒ nat ⇒
ex_table ⇒ ty⇩i' err list ⇒ instr list ⇒ bool"
where
"wt_lbv P C b Ts T⇩r mxs mxl⇩0 et cert ins ≡
check_cert P mxs ((case b of Static ⇒ 0 | NonStatic ⇒ 1)+size Ts+mxl⇩0) (size ins) cert ∧
0 < size ins ∧
(let start = Some ([],(case b of Static ⇒ [] | NonStatic ⇒ [OK (Class C)])
@((map OK Ts))@(replicate mxl⇩0 Err));
result = lbvjvm P mxs ((case b of Static ⇒ 0 | NonStatic ⇒ 1)+size Ts+mxl⇩0) T⇩r et cert ins (OK start)
in result ≠ Err)"
definition wt_jvm_prog_lbv :: "jvm_prog ⇒ prog_cert ⇒ bool"
where
"wt_jvm_prog_lbv P cert ≡
wf_prog (λP C (mn,b,Ts,T⇩r,(mxs,mxl⇩0,ins,et)). wt_lbv P C b Ts T⇩r mxs mxl⇩0 et (cert C mn) ins) P"
definition mk_cert :: "jvm_prog ⇒ nat ⇒ ty ⇒ ex_table ⇒ instr list
⇒ ty⇩m ⇒ ty⇩i' err list"
where
"mk_cert P mxs T⇩r et bs phi ≡ make_cert (exec P mxs T⇩r et bs) (map OK phi) (OK None)"
definition prg_cert :: "jvm_prog ⇒ ty⇩P ⇒ prog_cert"
where
"prg_cert P phi C mn ≡ let (C,b,Ts,T⇩r,(mxs,mxl⇩0,ins,et)) = method P C mn
in mk_cert P mxs T⇩r et ins (phi C mn)"
lemma check_certD [intro?]:
"check_cert P mxs mxl n cert ⟹ cert_ok cert n Err (OK None) (states P mxs mxl)"
by (unfold cert_ok_def check_cert_def check_types_def) auto
lemma (in start_context) wt_lbv_wt_step:
assumes lbv: "wt_lbv P C b Ts T⇩r mxs mxl⇩0 xt cert is"
shows "∃τs ∈ list (size is) A. wt_step r Err step τs ∧ OK first ⊑⇩r τs!0"
proof -
from wf have "semilat (JVM_SemiType.sl P mxs mxl)" ..
hence "semilat (A, r, f)" by (simp add: sl_def2)
moreover have "top r Err" by (simp add: JVM_le_Err_conv)
moreover have "Err ∈ A" by (simp add: JVM_states_unfold)
moreover have "bottom r (OK None)"
by (simp add: JVM_le_Err_conv bottom_def lesub_def Err.le_def split: err.split)
moreover have "OK None ∈ A" by (simp add: JVM_states_unfold)
moreover note bounded_step
moreover from lbv have "cert_ok cert (size is) Err (OK None) A"
by (unfold wt_lbv_def) (auto dest: check_certD)
moreover note exec_pres_type
moreover
from lbv
have "wtl_inst_list is cert f r Err (OK None) step 0 (OK first) ≠ Err"
by (cases b; simp add: wt_lbv_def lbvjvm_def step_def_exec [symmetric])
moreover note first_in_A
moreover from lbv have "0 < size is" by (simp add: wt_lbv_def)
ultimately show ?thesis by (rule lbvs.wtl_sound_strong [OF lbvs.intro, OF lbv.intro lbvs_axioms.intro, OF Semilat.intro lbv_axioms.intro])
qed
lemma (in start_context) wt_lbv_wt_method:
assumes lbv: "wt_lbv P C b Ts T⇩r mxs mxl⇩0 xt cert is"
shows "∃τs. wt_method P C b Ts T⇩r mxs mxl⇩0 is xt τs"
proof -
from lbv have l: "is ≠ []" by (simp add: wt_lbv_def)
moreover
from wf lbv C Ts obtain τs where
list: "τs ∈ list (size is) A" and
step: "wt_step r Err step τs" and
start: "OK first ⊑⇩r τs!0"
by (blast dest: wt_lbv_wt_step)
from list have [simp]: "size τs = size is" by simp
have "size (map ok_val τs) = size is" by simp
moreover from l have 0: "0 < size τs" by simp
with step obtain τs0 where "τs!0 = OK τs0"
by (unfold wt_step_def) blast
with start 0 have "wt_start P C b Ts mxl⇩0 (map ok_val τs)"
by (cases b; simp add: wt_start_def JVM_le_Err_conv lesub_def Err.le_def)
moreover {
from list have "check_types P mxs mxl τs" by (simp add: check_types_def)
also from step have "∀x ∈ set τs. x ≠ Err"
by (auto simp add: all_set_conv_all_nth wt_step_def)
hence [symmetric]: "map OK (map ok_val τs) = τs"
by (auto intro!: map_idI)
finally have "check_types P mxs mxl (map OK (map ok_val τs))" .
}
moreover {
note bounded_step
moreover from list have "set τs ⊆ A" by simp
moreover from step have "wt_err_step (sup_state_opt P) step τs"
by (simp add: wt_err_step_def JVM_le_Err_conv)
ultimately have "wt_app_eff (sup_state_opt P) app eff (map ok_val τs)"
by (auto intro: wt_err_imp_wt_app_eff simp add: exec_def states_def)
}
ultimately have "wt_method P C b Ts T⇩r mxs mxl⇩0 is xt (map ok_val τs)"
by (simp add: wt_method_def2 check_types_def del: map_map)
thus ?thesis ..
qed
lemma (in start_context) wt_method_wt_lbv:
assumes wt: "wt_method P C b Ts T⇩r mxs mxl⇩0 is xt τs"
defines [simp]: "cert ≡ mk_cert P mxs T⇩r xt is τs"
shows "wt_lbv P C b Ts T⇩r mxs mxl⇩0 xt cert is"
proof -
let ?τs = "map OK τs"
let ?cert = "make_cert step ?τs (OK None)"
from wt obtain
0: "0 < size is" and
size: "size is = size ?τs" and
ck_types: "check_types P mxs mxl ?τs" and
wt_start: "wt_start P C b Ts mxl⇩0 τs" and
app_eff: "wt_app_eff (sup_state_opt P) app eff τs"
by (force simp add: wt_method_def2 check_types_def)
from wf have "semilat (JVM_SemiType.sl P mxs mxl)" ..
hence "semilat (A, r, f)" by (simp add: sl_def2)
moreover have "top r Err" by (simp add: JVM_le_Err_conv)
moreover have "Err ∈ A" by (simp add: JVM_states_unfold)
moreover have "bottom r (OK None)"
by (simp add: JVM_le_Err_conv bottom_def lesub_def Err.le_def split: err.split)
moreover have "OK None ∈ A" by (simp add: JVM_states_unfold)
moreover from wf have "mono r step (size is) A" by (rule step_mono)
hence "mono r step (size ?τs) A" by (simp add: size)
moreover from exec_pres_type
have "pres_type step (size ?τs) A" by (simp add: size)
moreover
from ck_types have τs_in_A: "set ?τs ⊆ A" by (simp add: check_types_def)
hence "∀pc. pc < size ?τs ⟶ ?τs!pc ∈ A ∧ ?τs!pc ≠ Err" by auto
moreover from bounded_step
have "bounded step (size ?τs)" by (simp add: size)
moreover have "OK None ≠ Err" by simp
moreover from bounded_step size τs_in_A app_eff
have "wt_err_step (sup_state_opt P) step ?τs"
by (auto intro: wt_app_eff_imp_wt_err simp add: exec_def states_def)
hence "wt_step r Err step ?τs"
by (simp add: wt_err_step_def JVM_le_Err_conv)
moreover
from 0 size have "0 < size τs" by auto
hence "?τs!0 = OK (τs!0)" by simp
with wt_start have "OK first ⊑⇩r ?τs!0"
by (cases b; clarsimp simp add: wt_start_def lesub_def Err.le_def JVM_le_Err_conv)
moreover note first_in_A
moreover have "OK first ≠ Err" by simp
moreover note size
ultimately
have "wtl_inst_list is ?cert f r Err (OK None) step 0 (OK first) ≠ Err"
by (rule lbvc.wtl_complete [OF lbvc.intro, OF lbv.intro lbvc_axioms.intro, OF Semilat.intro lbv_axioms.intro])
moreover from 0 size have "τs ≠ []" by auto
moreover from ck_types have "check_types P mxs mxl ?cert"
apply (auto simp add: make_cert_def check_types_def JVM_states_unfold)
apply (subst Ok_in_err [symmetric])
apply (drule nth_mem)
apply auto
done
moreover note 0 size
ultimately show ?thesis
by (simp add: wt_lbv_def lbvjvm_def mk_cert_def step_def_exec [symmetric]
check_cert_def make_cert_def nth_append)
qed
theorem jvm_lbv_correct:
"wt_jvm_prog_lbv P Cert ⟹ wf_jvm_prog P"
proof -
let ?Φ = "λC mn. let (C,b,Ts,T⇩r,(mxs,mxl⇩0,is,xt)) = method P C mn in
SOME τs. wt_method P C b Ts T⇩r mxs mxl⇩0 is xt τs"
assume wt: "wt_jvm_prog_lbv P Cert"
hence "wf_jvm_prog⇘?Φ⇙ P"
apply (unfold wf_jvm_prog_phi_def wt_jvm_prog_lbv_def)
apply (erule wf_prog_lift)
apply (auto dest!: start_context.wt_lbv_wt_method [OF start_context.intro]
intro: someI)
apply (erule sees_method_is_class)
done
thus ?thesis by (unfold wf_jvm_prog_def) blast
qed
theorem jvm_lbv_complete:
assumes wt: "wf_jvm_prog⇘Φ⇙ P"
shows "wt_jvm_prog_lbv P (prg_cert P Φ)"
using wt
apply (unfold wf_jvm_prog_phi_def wt_jvm_prog_lbv_def)
apply (erule wf_prog_lift)
apply (auto simp add: prg_cert_def
intro!: start_context.wt_method_wt_lbv start_context.intro)
apply (erule sees_method_is_class)
done
end
Theory BVConform
section ‹ BV Type Safety Invariant ›
theory BVConform
imports BVSpec "../JVM/JVMExec" "../Common/Conform"
begin
subsection ‹ @{text "correct_state"} definitions ›
definition confT :: "'c prog ⇒ heap ⇒ val ⇒ ty err ⇒ bool"
("_,_ ⊢ _ :≤⇩⊤ _" [51,51,51,51] 50)
where
"P,h ⊢ v :≤⇩⊤ E ≡ case E of Err ⇒ True | OK T ⇒ P,h ⊢ v :≤ T"
notation (ASCII)
confT ("_,_ |- _ :<=T _" [51,51,51,51] 50)
abbreviation
confTs :: "'c prog ⇒ heap ⇒ val list ⇒ ty⇩l ⇒ bool"
("_,_ ⊢ _ [:≤⇩⊤] _" [51,51,51,51] 50) where
"P,h ⊢ vs [:≤⇩⊤] Ts ≡ list_all2 (confT P h) vs Ts"
notation (ASCII)
confTs ("_,_ |- _ [:<=T] _" [51,51,51,51] 50)
fun Called_context :: "jvm_prog ⇒ cname ⇒ instr ⇒ bool" where
"Called_context P C⇩0 (New C') = (C⇩0=C')" |
"Called_context P C⇩0 (Getstatic C F D) = ((C⇩0=D) ∧ (∃t. P ⊢ C has F,Static:t in D))" |
"Called_context P C⇩0 (Putstatic C F D) = ((C⇩0=D) ∧ (∃t. P ⊢ C has F,Static:t in D))" |
"Called_context P C⇩0 (Invokestatic C M n)
= (∃Ts T m D. (C⇩0=D) ∧ P ⊢ C sees M,Static:Ts → T = m in D)" |
"Called_context P _ _ = False"
abbreviation Called_set :: "instr set" where
"Called_set ≡ {i. ∃C. i = New C} ∪ {i. ∃C M n. i = Invokestatic C M n}
∪ {i. ∃C F D. i = Getstatic C F D} ∪ {i. ∃C F D. i = Putstatic C F D}"
lemma Called_context_Called_set:
"Called_context P D i ⟹ i ∈ Called_set" by(cases i, auto)
fun valid_ics :: "jvm_prog ⇒ heap ⇒ sheap ⇒ cname × mname × pc × init_call_status ⇒ bool"
("_,_,_ ⊢⇩i _" [51,51,51,51] 50) where
"valid_ics P h sh (C,M,pc,Calling C' Cs)
= (let ins = instrs_of P C M in Called_context P (last (C'#Cs)) (ins!pc)
∧ is_class P C')" |
"valid_ics P h sh (C,M,pc,Throwing Cs a)
=(let ins = instrs_of P C M in ∃C1. Called_context P C1 (ins!pc)
∧ (∃obj. h a = Some obj))" |
"valid_ics P h sh (C,M,pc,Called Cs)
= (let ins = instrs_of P C M
in ∃C1 sobj. Called_context P C1 (ins!pc) ∧ sh C1 = Some sobj)" |
"valid_ics P _ _ _ = True"
definition conf_f :: "jvm_prog ⇒ heap ⇒ sheap ⇒ ty⇩i ⇒ bytecode ⇒ frame ⇒ bool"
where
"conf_f P h sh ≡ λ(ST,LT) is (stk,loc,C,M,pc,ics).
P,h ⊢ stk [:≤] ST ∧ P,h ⊢ loc [:≤⇩⊤] LT ∧ pc < size is ∧ P,h,sh ⊢⇩i (C,M,pc,ics)"
lemma conf_f_def2:
"conf_f P h sh (ST,LT) is (stk,loc,C,M,pc,ics) ≡
P,h ⊢ stk [:≤] ST ∧ P,h ⊢ loc [:≤⇩⊤] LT ∧ pc < size is ∧ P,h,sh ⊢⇩i (C,M,pc,ics)"
by (simp add: conf_f_def)
primrec conf_fs :: "[jvm_prog,heap,sheap,ty⇩P,cname,mname,nat,ty,frame list] ⇒ bool"
where
"conf_fs P h sh Φ C⇩0 M⇩0 n⇩0 T⇩0 [] = True"
| "conf_fs P h sh Φ C⇩0 M⇩0 n⇩0 T⇩0 (f#frs) =
(let (stk,loc,C,M,pc,ics) = f in
(∃ST LT b Ts T mxs mxl⇩0 is xt.
Φ C M ! pc = Some (ST,LT) ∧
(P ⊢ C sees M,b:Ts → T = (mxs,mxl⇩0,is,xt) in C) ∧
((∃D Ts' T' m D'. M⇩0 ≠ clinit ∧ ics = No_ics ∧
is!pc = Invoke M⇩0 n⇩0 ∧ ST!n⇩0 = Class D ∧
P ⊢ D sees M⇩0,NonStatic:Ts' → T' = m in D' ∧ P ⊢ C⇩0 ≼⇧* D' ∧ P ⊢ T⇩0 ≤ T') ∨
(∃D Ts' T' m. M⇩0 ≠ clinit ∧ ics = No_ics ∧
is!pc = Invokestatic D M⇩0 n⇩0 ∧
P ⊢ D sees M⇩0,Static:Ts' → T' = m in C⇩0 ∧ P ⊢ T⇩0 ≤ T') ∨
(M⇩0 = clinit ∧ (∃Cs. ics = Called Cs))) ∧
conf_f P h sh (ST, LT) is f ∧ conf_fs P h sh Φ C M (size Ts) T frs))"
fun ics_classes :: "init_call_status ⇒ cname list" where
"ics_classes (Calling C Cs) = Cs" |
"ics_classes (Throwing Cs a) = Cs" |
"ics_classes (Called Cs) = Cs" |
"ics_classes _ = []"
fun frame_clinit_classes :: "frame ⇒ cname list" where
"frame_clinit_classes (stk,loc,C,M,pc,ics) = (if M=clinit then [C] else []) @ ics_classes ics"
abbreviation clinit_classes :: "frame list ⇒ cname list" where
"clinit_classes frs ≡ concat (map frame_clinit_classes frs)"
definition distinct_clinit :: "frame list ⇒ bool" where
"distinct_clinit frs ≡ distinct (clinit_classes frs)"
definition conf_clinit :: "jvm_prog ⇒ sheap ⇒ frame list ⇒ bool" where
"conf_clinit P sh frs
≡ distinct_clinit frs ∧
(∀C ∈ set(clinit_classes frs). is_class P C ∧ (∃sfs. sh C = Some(sfs, Processing)))"
definition correct_state :: "[jvm_prog,ty⇩P,jvm_state] ⇒ bool" ("_,_ ⊢ _ √" [61,0,0] 61)
where
"correct_state P Φ ≡ λ(xp,h,frs,sh).
case xp of
None ⇒ (case frs of
[] ⇒ True
| (f#fs) ⇒ P⊢ h√ ∧ P,h⊢⇩s sh√ ∧ conf_clinit P sh frs ∧
(let (stk,loc,C,M,pc,ics) = f
in ∃b Ts T mxs mxl⇩0 is xt τ.
(P ⊢ C sees M,b:Ts→T = (mxs,mxl⇩0,is,xt) in C) ∧
Φ C M ! pc = Some τ ∧
conf_f P h sh τ is f ∧ conf_fs P h sh Φ C M (size Ts) T fs))
| Some x ⇒ frs = []"
notation
correct_state ("_,_ |- _ [ok]" [61,0,0] 61)
subsection ‹ Values and @{text "⊤"} ›
lemma confT_Err [iff]: "P,h ⊢ x :≤⇩⊤ Err"
by (simp add: confT_def)
lemma confT_OK [iff]: "P,h ⊢ x :≤⇩⊤ OK T = (P,h ⊢ x :≤ T)"
by (simp add: confT_def)
lemma confT_cases:
"P,h ⊢ x :≤⇩⊤ X = (X = Err ∨ (∃T. X = OK T ∧ P,h ⊢ x :≤ T))"
by (cases X) auto
lemma confT_hext [intro?, trans]:
"⟦ P,h ⊢ x :≤⇩⊤ T; h ⊴ h' ⟧ ⟹ P,h' ⊢ x :≤⇩⊤ T"
by (cases T) (blast intro: conf_hext)+
lemma confT_widen [intro?, trans]:
"⟦ P,h ⊢ x :≤⇩⊤ T; P ⊢ T ≤⇩⊤ T' ⟧ ⟹ P,h ⊢ x :≤⇩⊤ T'"
by (cases T', auto intro: conf_widen)
subsection ‹ Stack and Registers ›
lemmas confTs_Cons1 [iff] = list_all2_Cons1 [of "confT P h"] for P h
lemma confTs_confT_sup:
"⟦ P,h ⊢ loc [:≤⇩⊤] LT; n < size LT; LT!n = OK T; P ⊢ T ≤ T' ⟧
⟹ P,h ⊢ (loc!n) :≤ T'"
apply (frule list_all2_lengthD)
apply (drule list_all2_nthD, simp)
apply simp
apply (erule conf_widen, assumption+)
done
lemma confTs_hext [intro?]:
"P,h ⊢ loc [:≤⇩⊤] LT ⟹ h ⊴ h' ⟹ P,h' ⊢ loc [:≤⇩⊤] LT"
by (fast elim: list_all2_mono confT_hext)
lemma confTs_widen [intro?, trans]:
"P,h ⊢ loc [:≤⇩⊤] LT ⟹ P ⊢ LT [≤⇩⊤] LT' ⟹ P,h ⊢ loc [:≤⇩⊤] LT'"
by (rule list_all2_trans, rule confT_widen)
lemma confTs_map [iff]:
"⋀vs. (P,h ⊢ vs [:≤⇩⊤] map OK Ts) = (P,h ⊢ vs [:≤] Ts)"
by (induct Ts) (auto simp: list_all2_Cons2)
lemma reg_widen_Err [iff]:
"⋀LT. (P ⊢ replicate n Err [≤⇩⊤] LT) = (LT = replicate n Err)"
by (induct n) (auto simp: list_all2_Cons1)
lemma confTs_Err [iff]:
"P,h ⊢ replicate n v [:≤⇩⊤] replicate n Err"
by (induct n) auto
subsection ‹ valid @{text "init_call_status"} ›
lemma valid_ics_shupd:
assumes "P,h,sh ⊢⇩i (C, M, pc, ics)" and "distinct (C'#ics_classes ics)"
shows "P,h,sh(C' ↦ (sfs, i')) ⊢⇩i (C, M, pc, ics)"
using assms by(cases ics; clarsimp simp: fun_upd_apply) fastforce
subsection ‹ correct-frame ›
lemma conf_f_Throwing:
assumes "conf_f P h sh (ST, LT) is (stk, loc, C, M, pc, Called Cs)"
and "is_class P C'" and "h xcp = Some obj" and "sh C' = Some(sfs,Processing)"
shows "conf_f P h sh (ST, LT) is (stk, loc, C, M, pc, Throwing (C' # Cs) xcp)"
using assms by(auto simp: conf_f_def2)
lemma conf_f_shupd:
assumes "conf_f P h sh (ST,LT) ins f"
and "i = Processing
∨ (distinct (C#ics_classes (ics_of f)) ∧ (curr_method f = clinit ⟶ C ≠ curr_class f))"
shows "conf_f P h (sh(C ↦ (sfs, i))) (ST,LT) ins f"
using assms
by(cases f, cases "ics_of f"; clarsimp simp: conf_f_def2 fun_upd_apply) fastforce+
lemma conf_f_shupd':
assumes "conf_f P h sh (ST,LT) ins f"
and "sh C = Some(sfs,i)"
shows "conf_f P h (sh(C ↦ (sfs', i))) (ST,LT) ins f"
using assms
by(cases f, cases "ics_of f"; clarsimp simp: conf_f_def2 fun_upd_apply) fastforce+
subsection ‹ correct-frames ›
lemmas [simp del] = fun_upd_apply
lemma conf_fs_hext:
"⋀C M n T⇩r.
⟦ conf_fs P h sh Φ C M n T⇩r frs; h ⊴ h' ⟧ ⟹ conf_fs P h' sh Φ C M n T⇩r frs"
apply (induct frs)
apply simp
apply clarify
apply (simp (no_asm_use))
apply clarify
apply (unfold conf_f_def)
apply (simp (no_asm_use))
apply clarify
apply (fastforce elim!: confs_hext confTs_hext)
done
lemma conf_fs_shupd:
assumes "conf_fs P h sh Φ C⇩0 M n T frs"
and dist: "distinct (C#clinit_classes frs)"
shows "conf_fs P h (sh(C ↦ (sfs, i))) Φ C⇩0 M n T frs"
using assms proof(induct frs arbitrary: C⇩0 C M n T)
case (Cons f' frs')
then obtain stk' loc' C' M' pc' ics' where f': "f' = (stk',loc',C',M',pc',ics')" by(cases f')
with assms Cons obtain ST LT b Ts T1 mxs mxl⇩0 ins xt where
ty: "Φ C' M' ! pc' = Some (ST,LT)" and
meth: "P ⊢ C' sees M',b:Ts → T1 = (mxs,mxl⇩0,ins,xt) in C'" and
conf: "conf_f P h sh (ST, LT) ins f'" and
confs: "conf_fs P h sh Φ C' M' (size Ts) T1 frs'" by clarsimp
from f' Cons.prems(2) have
"distinct (C#ics_classes (ics_of f')) ∧ (curr_method f' = clinit ⟶ C ≠ curr_class f')"
by fastforce
with conf_f_shupd[where C=C, OF conf] have
conf': "conf_f P h (sh(C ↦ (sfs, i))) (ST, LT) ins f'" by simp
from Cons.prems(2) have dist': "distinct (C # clinit_classes frs')"
by(auto simp: distinct_length_2_or_more)
from Cons.hyps[OF confs dist'] have
confs': "conf_fs P h (sh(C ↦ (sfs, i))) Φ C' M' (length Ts) T1 frs'" by simp
from conf' confs' ty meth f' Cons.prems show ?case by(fastforce dest: sees_method_fun)
qed(simp)
lemma conf_fs_shupd':
assumes "conf_fs P h sh Φ C⇩0 M n T frs"
and shC: "sh C = Some(sfs,i)"
shows "conf_fs P h (sh(C ↦ (sfs', i))) Φ C⇩0 M n T frs"
using assms proof(induct frs arbitrary: C⇩0 C M n T sfs i sfs')
case (Cons f' frs')
then obtain stk' loc' C' M' pc' ics' where f': "f' = (stk',loc',C',M',pc',ics')" by(cases f')
with assms Cons obtain ST LT b Ts T1 mxs mxl⇩0 ins xt where
ty: "Φ C' M' ! pc' = Some (ST,LT)" and
meth: "P ⊢ C' sees M',b:Ts → T1 = (mxs,mxl⇩0,ins,xt) in C'" and
conf: "conf_f P h sh (ST, LT) ins f'" and
confs: "conf_fs P h sh Φ C' M' (size Ts) T1 frs'" and
shC': "sh C = Some(sfs,i)" by clarsimp
have conf': "conf_f P h (sh(C ↦ (sfs', i))) (ST, LT) ins f'" by(rule conf_f_shupd'[OF conf shC'])
from Cons.hyps[OF confs shC'] have
confs': "conf_fs P h (sh(C ↦ (sfs', i))) Φ C' M' (length Ts) T1 frs'" by simp
from conf' confs' ty meth f' Cons.prems show ?case by(fastforce dest: sees_method_fun)
qed(simp)
subsection ‹ correctness wrt @{term clinit} use ›
lemma conf_clinit_Cons:
assumes "conf_clinit P sh (f#frs)"
shows "conf_clinit P sh frs"
proof -
from assms have dist: "distinct_clinit (f#frs)"
by(cases "curr_method f = clinit", auto simp: conf_clinit_def)
then have dist': "distinct_clinit frs" by(simp add: distinct_clinit_def)
with assms show ?thesis by(cases frs; fastforce simp: conf_clinit_def)
qed
lemma conf_clinit_Cons_Cons:
"conf_clinit P sh (f'#f#frs) ⟹ conf_clinit P sh (f'#frs)"
by(auto simp: conf_clinit_def distinct_clinit_def)
lemma conf_clinit_diff:
assumes "conf_clinit P sh ((stk,loc,C,M,pc,ics)#frs)"
shows "conf_clinit P sh ((stk',loc',C,M,pc',ics)#frs)"
using assms by(cases "M = clinit", simp_all add: conf_clinit_def distinct_clinit_def)
lemma conf_clinit_diff':
assumes "conf_clinit P sh ((stk,loc,C,M,pc,ics)#frs)"
shows "conf_clinit P sh ((stk',loc',C,M,pc',No_ics)#frs)"
using assms by(cases "M = clinit", simp_all add: conf_clinit_def distinct_clinit_def)
lemma conf_clinit_Called_Throwing:
"conf_clinit P sh ((stk', loc', C', clinit, pc', ics') # (stk, loc, C, M, pc, Called Cs) # fs)
⟹ conf_clinit P sh ((stk, loc, C, M, pc, Throwing (C' # Cs) xcp) # fs)"
by(simp add: conf_clinit_def distinct_clinit_def)
lemma conf_clinit_Throwing:
"conf_clinit P sh ((stk, loc, C, M, pc, Throwing (C'#Cs) xcp) # fs)
⟹ conf_clinit P sh ((stk, loc, C, M, pc, Throwing Cs xcp) # fs)"
by(simp add: conf_clinit_def distinct_clinit_def)
lemma conf_clinit_Called:
"⟦ conf_clinit P sh ((stk, loc, C, M, pc, Called (C'#Cs)) # frs);
P ⊢ C' sees clinit,Static: [] → Void=(mxs',mxl',ins',xt') in C' ⟧
⟹ conf_clinit P sh (create_init_frame P C' # (stk, loc, C, M, pc, Called Cs) # frs)"
by(simp add: conf_clinit_def distinct_clinit_def)
lemma conf_clinit_Cons_nclinit:
assumes "conf_clinit P sh frs" and nclinit: "M ≠ clinit"
shows "conf_clinit P sh ((stk, loc, C, M, pc, No_ics) # frs)"
proof -
from nclinit
have "clinit_classes ((stk, loc, C, M, pc, No_ics) # frs) = clinit_classes frs" by simp
with assms show ?thesis by(simp add: conf_clinit_def distinct_clinit_def)
qed
lemma conf_clinit_Invoke:
assumes "conf_clinit P sh ((stk, loc, C, M, pc, ics) # frs)" and "M' ≠ clinit"
shows "conf_clinit P sh ((stk', loc', C', M', pc', No_ics) # (stk, loc, C, M, pc, No_ics) # frs)"
using assms conf_clinit_Cons_nclinit conf_clinit_diff' by auto
lemma conf_clinit_nProc_dist:
assumes "conf_clinit P sh frs"
and "∀sfs. sh C ≠ Some(sfs,Processing)"
shows "distinct (C # clinit_classes frs)"
using assms by(auto simp: conf_clinit_def distinct_clinit_def)
lemma conf_clinit_shupd:
assumes "conf_clinit P sh frs"
and dist: "distinct (C#clinit_classes frs)"
shows "conf_clinit P (sh(C ↦ (sfs, i))) frs"
using assms by(simp add: conf_clinit_def fun_upd_apply)
lemma conf_clinit_shupd':
assumes "conf_clinit P sh frs"
and "sh C = Some(sfs,i)"
shows "conf_clinit P (sh(C ↦ (sfs', i))) frs"
using assms by(fastforce simp: conf_clinit_def fun_upd_apply)
lemma conf_clinit_shupd_Called:
assumes "conf_clinit P sh ((stk,loc,C,M,pc,Calling C' Cs)#frs)"
and dist: "distinct (C'#clinit_classes ((stk,loc,C,M,pc,Calling C' Cs)#frs))"
and cls: "is_class P C'"
shows "conf_clinit P (sh(C' ↦ (sfs, Processing))) ((stk,loc,C,M,pc,Called (C'#Cs))#frs)"
using assms by(clarsimp simp: conf_clinit_def fun_upd_apply distinct_clinit_def)
lemma conf_clinit_shupd_Calling:
assumes "conf_clinit P sh ((stk,loc,C,M,pc,Calling C' Cs)#frs)"
and dist: "distinct (C'#clinit_classes ((stk,loc,C,M,pc,Calling C' Cs)#frs))"
and cls: "is_class P C'"
shows "conf_clinit P (sh(C' ↦ (sfs, Processing)))
((stk,loc,C,M,pc,Calling (fst(the(class P C'))) (C'#Cs))#frs)"
using assms by(clarsimp simp: conf_clinit_def fun_upd_apply distinct_clinit_def)
subsection ‹ correct state ›
lemma correct_state_Cons:
assumes cr: "P,Φ |- (xp,h,f#frs,sh) [ok]"
shows "P,Φ |- (xp,h,frs,sh) [ok]"
proof -
from cr have dist: "conf_clinit P sh (f#frs)"
by(simp add: correct_state_def)
then have "conf_clinit P sh frs" by(rule conf_clinit_Cons)
with cr show ?thesis by(cases frs; fastforce simp: correct_state_def)
qed
lemma correct_state_shupd:
assumes cs: "P,Φ |- (xp,h,frs,sh) [ok]" and shC: "sh C = Some(sfs,i)"
and dist: "distinct (C#clinit_classes frs)"
shows "P,Φ |- (xp,h,frs,sh(C ↦ (sfs, i'))) [ok]"
using assms
proof(cases xp)
case None with assms show ?thesis
proof(cases frs)
case (Cons f' frs')
let ?sh = "sh(C ↦ (sfs, i'))"
obtain stk' loc' C' M' pc' ics' where f': "f' = (stk',loc',C',M',pc',ics')" by(cases f')
with cs Cons None obtain b Ts T mxs mxl⇩0 ins xt ST LT where
meth: "P ⊢ C' sees M',b:Ts→T = (mxs,mxl⇩0,ins,xt) in C'"
and ty: "Φ C' M' ! pc' = Some (ST,LT)" and conf: "conf_f P h sh (ST,LT) ins f'"
and confs: "conf_fs P h sh Φ C' M' (size Ts) T frs'"
and confc: "conf_clinit P sh frs"
and h_ok: "P⊢ h√" and sh_ok: "P,h ⊢⇩s sh √"
by(auto simp: correct_state_def)
from Cons dist have dist': "distinct (C#clinit_classes frs')"
by(auto simp: distinct_length_2_or_more)
from shconf_upd_obj[OF sh_ok shconfD[OF sh_ok shC]] have sh_ok': "P,h ⊢⇩s ?sh √"
by simp
from conf f' valid_ics_shupd Cons dist have conf': "conf_f P h ?sh (ST,LT) ins f'"
by(auto simp: conf_f_def2 fun_upd_apply)
have confs': "conf_fs P h ?sh Φ C' M' (size Ts) T frs'" by(rule conf_fs_shupd[OF confs dist'])
have confc': "conf_clinit P ?sh frs" by(rule conf_clinit_shupd[OF confc dist])
with h_ok sh_ok' meth ty conf' confs' f' Cons None show ?thesis
by(fastforce simp: correct_state_def)
qed(simp add: correct_state_def)
qed(simp add: correct_state_def)
lemma correct_state_Throwing_ex:
assumes correct: "P,Φ ⊢ (xp,h,(stk,loc,C,M,pc,ics)#frs,sh)√"
shows "⋀Cs a. ics = Throwing Cs a ⟹ ∃obj. h a = Some obj"
using correct by(clarsimp simp: correct_state_def conf_f_def)
end
Theory ClassAdd
section ‹ Property preservation under @{text "class_add"} ›
theory ClassAdd
imports BVConform
begin
lemma err_mono: "A ⊆ B ⟹ err A ⊆ err B"
by(unfold err_def) auto
lemma opt_mono: "A ⊆ B ⟹ opt A ⊆ opt B"
by(unfold opt_def) auto
lemma list_mono:
assumes "A ⊆ B" shows "list n A ⊆ list n B"
proof(rule)
fix xs assume "xs ∈ list n A"
then obtain size: "size xs = n" and inA: "set xs ⊆ A" by simp
with assms have "set xs ⊆ B" by simp
with size show "xs ∈ list n B" by(clarsimp intro!: listI)
qed
abbreviation class_add :: "jvm_prog ⇒ jvm_method cdecl ⇒ jvm_prog" where
"class_add P cd ≡ cd#P"
subsection "Fields"
lemma class_add_has_fields:
assumes fs: "P ⊢ D has_fields FDTs" and nc: "¬is_class P C"
shows "class_add P (C, cdec) ⊢ D has_fields FDTs"
using assms
proof(induct rule: Fields.induct)
case (has_fields_Object D fs ms FDTs)
from has_fields_is_class_Object[OF fs] nc have "C ≠ Object" by fast
with has_fields_Object show ?case
by(auto simp: class_def fun_upd_apply intro!: TypeRel.has_fields_Object)
next
case rec: (has_fields_rec C1 D fs ms FDTs FDTs')
with has_fields_is_class have [simp]: "D ≠ C" by auto
with rec have "C1 ≠ C" by(clarsimp simp: is_class_def)
with rec show ?case
by(auto simp: class_def fun_upd_apply intro: TypeRel.has_fields_rec)
qed
lemma class_add_has_fields_rev:
"⟦ class_add P (C, cdec) ⊢ D has_fields FDTs; ¬P ⊢ D ≼⇧* C ⟧
⟹ P ⊢ D has_fields FDTs"
proof(induct rule: Fields.induct)
case (has_fields_Object D fs ms FDTs)
then show ?case by(auto simp: class_def fun_upd_apply intro!: TypeRel.has_fields_Object)
next
case rec: (has_fields_rec C1 D fs ms FDTs FDTs')
then have sub1: "P ⊢ C1 ≺⇧1 D"
by(auto simp: class_def fun_upd_apply intro!: subcls1I split: if_split_asm)
with rec.prems have cls: "¬ P ⊢ D ≼⇧* C" by (meson converse_rtrancl_into_rtrancl)
with cls rec show ?case
by(auto simp: class_def fun_upd_apply
intro: TypeRel.has_fields_rec split: if_split_asm)
qed
lemma class_add_has_field:
assumes "P ⊢ C⇩0 has F,b:T in D" and "¬ is_class P C"
shows "class_add P (C, cdec) ⊢ C⇩0 has F,b:T in D"
using assms by(auto simp: has_field_def dest!: class_add_has_fields[of P C⇩0])
lemma class_add_has_field_rev:
assumes has: "class_add P (C, cdec) ⊢ C⇩0 has F,b:T in D"
and ncp: "⋀D'. P ⊢ C⇩0 ≼⇧* D' ⟹ D' ≠ C"
shows "P ⊢ C⇩0 has F,b:T in D"
using assms by(auto simp: has_field_def dest!: class_add_has_fields_rev)
lemma class_add_sees_field:
assumes "P ⊢ C⇩0 sees F,b:T in D" and "¬ is_class P C"
shows "class_add P (C, cdec) ⊢ C⇩0 sees F,b:T in D"
using assms by(auto simp: sees_field_def dest!: class_add_has_fields[of P C⇩0])
lemma class_add_sees_field_rev:
assumes has: "class_add P (C, cdec) ⊢ C⇩0 sees F,b:T in D"
and ncp: "⋀D'. P ⊢ C⇩0 ≼⇧* D' ⟹ D' ≠ C"
shows "P ⊢ C⇩0 sees F,b:T in D"
using assms by(auto simp: sees_field_def dest!: class_add_has_fields_rev)
lemma class_add_field:
assumes fd: "P ⊢ C⇩0 sees F,b:T in D" and "¬ is_class P C"
shows "field P C⇩0 F = field (class_add P (C, cdec)) C⇩0 F"
using class_add_sees_field[OF assms, of cdec] fd by simp
subsection "Methods"
lemma class_add_sees_methods:
assumes ms: "P ⊢ D sees_methods Mm" and nc: "¬is_class P C"
shows "class_add P (C, cdec) ⊢ D sees_methods Mm"
using assms
proof(induct rule: Methods.induct)
case (sees_methods_Object D fs ms Mm)
from sees_methods_is_class_Object[OF ms] nc have "C ≠ Object" by fast
with sees_methods_Object show ?case
by(auto simp: class_def fun_upd_apply intro!: TypeRel.sees_methods_Object)
next
case rec: (sees_methods_rec C1 D fs ms Mm Mm')
with sees_methods_is_class have [simp]: "D ≠ C" by auto
with rec have "C1 ≠ C" by(clarsimp simp: is_class_def)
with rec show ?case
by(auto simp: class_def fun_upd_apply intro: TypeRel.sees_methods_rec)
qed
lemma class_add_sees_methods_rev:
"⟦ class_add P (C, cdec) ⊢ D sees_methods Mm;
⋀D'. P ⊢ D ≼⇧* D' ⟹ D' ≠ C ⟧
⟹ P ⊢ D sees_methods Mm"
proof(induct rule: Methods.induct)
case (sees_methods_Object D fs ms Mm)
then show ?case
by(auto simp: class_def fun_upd_apply intro!: TypeRel.sees_methods_Object)
next
case rec: (sees_methods_rec C1 D fs ms Mm Mm')
then have sub1: "P ⊢ C1 ≺⇧1 D"
by(auto simp: class_def fun_upd_apply intro!: subcls1I)
have cls: "⋀D'. P ⊢ D ≼⇧* D' ⟹ D' ≠ C"
proof -
fix D' assume "P ⊢ D ≼⇧* D'"
with sub1 have "P ⊢ C1 ≼⇧* D'" by simp
with rec.prems show "D' ≠ C" by simp
qed
with cls rec show ?case
by(auto simp: class_def fun_upd_apply intro: TypeRel.sees_methods_rec)
qed
lemma class_add_sees_methods_Obj:
assumes "P ⊢ Object sees_methods Mm" and nObj: "C ≠ Object"
shows "class_add P (C, cdec) ⊢ Object sees_methods Mm"
proof -
from assms obtain C' fs ms where cls: "class P Object = Some(C',fs,ms)"
by(auto elim!: Methods.cases)
with nObj have cls': "class (class_add P (C, cdec)) Object = Some(C',fs,ms)"
by(simp add: class_def fun_upd_apply)
from assms cls have "Mm = map_option (λm. (m, Object)) ∘ map_of ms" by(auto elim!: Methods.cases)
with assms cls' show ?thesis
by(auto simp: is_class_def fun_upd_apply intro!: sees_methods_Object)
qed
lemma class_add_sees_methods_rev_Obj:
assumes "class_add P (C, cdec) ⊢ Object sees_methods Mm" and nObj: "C ≠ Object"
shows "P ⊢ Object sees_methods Mm"
proof -
from assms obtain C' fs ms where cls: "class (class_add P (C, cdec)) Object = Some(C',fs,ms)"
by(auto elim!: Methods.cases)
with nObj have cls': "class P Object = Some(C',fs,ms)"
by(simp add: class_def fun_upd_apply)
from assms cls have "Mm = map_option (λm. (m, Object)) ∘ map_of ms" by(auto elim!: Methods.cases)
with assms cls' show ?thesis
by(auto simp: is_class_def fun_upd_apply intro!: sees_methods_Object)
qed
lemma class_add_sees_method:
assumes "P ⊢ C⇩0 sees M⇩0, b : Ts→T = m in D" and "¬ is_class P C"
shows "class_add P (C, cdec) ⊢ C⇩0 sees M⇩0, b : Ts→T = m in D"
using assms by(auto simp: Method_def dest!: class_add_sees_methods[of P C⇩0])
lemma class_add_method:
assumes md: "P ⊢ C⇩0 sees M⇩0, b : Ts→T = m in D" and "¬ is_class P C"
shows "method P C⇩0 M⇩0 = method (class_add P (C, cdec)) C⇩0 M⇩0"
using class_add_sees_method[OF assms, of cdec] md by simp
lemma class_add_sees_method_rev:
"⟦ class_add P (C, cdec) ⊢ C⇩0 sees M⇩0, b : Ts→T = m in D;
¬ P ⊢ C⇩0 ≼⇧* C ⟧
⟹ P ⊢ C⇩0 sees M⇩0, b : Ts→T = m in D"
by(auto simp: Method_def dest!: class_add_sees_methods_rev)
lemma class_add_sees_method_Obj:
"⟦ P ⊢ Object sees M⇩0, b : Ts→T = m in D; C ≠ Object ⟧
⟹ class_add P (C, cdec) ⊢ Object sees M⇩0, b : Ts→T = m in D"
by(auto simp: Method_def dest!: class_add_sees_methods_Obj[where P=P])
lemma class_add_sees_method_rev_Obj:
"⟦ class_add P (C, cdec) ⊢ Object sees M⇩0, b : Ts→T = m in D; C ≠ Object ⟧
⟹ P ⊢ Object sees M⇩0, b : Ts→T = m in D"
by(auto simp: Method_def dest!: class_add_sees_methods_rev_Obj[where P=P])
subsection "Types and states"
lemma class_add_is_type:
"is_type P T ⟹ is_type (class_add P (C, cdec)) T"
by(cases cdec, simp add: is_type_def is_class_def class_def fun_upd_apply split: ty.splits)
lemma class_add_types:
"types P ⊆ types (class_add P (C, cdec))"
using class_add_is_type by(cases cdec, clarsimp)
lemma class_add_states:
"states P mxs mxl ⊆ states (class_add P (C, cdec)) mxs mxl"
proof -
let ?A = "types P" and ?B = "types (class_add P (C, cdec))"
have ab: "?A ⊆ ?B" by(rule class_add_types)
moreover have "⋀n. list n ?A ⊆ list n ?B" using ab by(rule list_mono)
moreover have "list mxl (err ?A) ⊆ list mxl (err ?B)" using err_mono[OF ab] by(rule list_mono)
ultimately show ?thesis by(auto simp: JVM_states_unfold intro!: err_mono opt_mono)
qed
lemma class_add_check_types:
"check_types P mxs mxl τs ⟹ check_types (class_add P (C, cdec)) mxs mxl τs"
using class_add_states by(fastforce simp: check_types_def)
subsection "Subclasses and subtypes"
lemma class_add_subcls:
"⟦ P ⊢ D ≼⇧* D'; ¬ is_class P C ⟧
⟹ class_add P (C, cdec) ⊢ D ≼⇧* D'"
proof(induct rule: rtrancl.induct)
case (rtrancl_into_rtrancl a b c)
then have "b ≠ C" by(clarsimp simp: is_class_def dest!: subcls1D)
with rtrancl_into_rtrancl show ?case
by(fastforce dest!: subcls1D simp: class_def fun_upd_apply
intro!: rtrancl_trans[of a b] subcls1I)
qed(simp)
lemma class_add_subcls_rev:
"⟦ class_add P (C, cdec) ⊢ D ≼⇧* D'; ¬P ⊢ D ≼⇧* C ⟧
⟹ P ⊢ D ≼⇧* D'"
proof(induct rule: rtrancl.induct)
case (rtrancl_into_rtrancl a b c)
then have "b ≠ C" by(clarsimp simp: is_class_def dest!: subcls1D)
with rtrancl_into_rtrancl show ?case
by(fastforce dest!: subcls1D simp: class_def fun_upd_apply
intro!: rtrancl_trans[of a b] subcls1I)
qed(simp)
lemma class_add_subtype:
"⟦ subtype P x y; ¬ is_class P C ⟧
⟹ subtype (class_add P (C, cdec)) x y"
proof(induct rule: widen.induct)
case (widen_subcls C D)
then show ?case using class_add_subcls by simp
qed(simp+)
lemma class_add_widens:
"⟦ P ⊢ Ts [≤] Ts'; ¬ is_class P C ⟧
⟹ (class_add P (C, cdec)) ⊢ Ts [≤] Ts'"
using class_add_subtype by (metis (no_types) list_all2_mono)
lemma class_add_sup_ty_opt:
"⟦ P ⊢ l1 ≤⇩⊤ l2; ¬ is_class P C ⟧
⟹ class_add P (C, cdec) ⊢ l1 ≤⇩⊤ l2"
using class_add_subtype by(auto simp: sup_ty_opt_def Err.le_def lesub_def split: err.splits)
lemma class_add_sup_loc:
"⟦ P ⊢ LT [≤⇩⊤] LT'; ¬ is_class P C ⟧
⟹ class_add P (C, cdec) ⊢ LT [≤⇩⊤] LT'"
using class_add_sup_ty_opt[where P=P and C=C] by (simp add: list.rel_mono_strong)
lemma class_add_sup_state:
"⟦ P ⊢ τ ≤⇩i τ'; ¬ is_class P C ⟧
⟹ class_add P (C, cdec) ⊢ τ ≤⇩i τ'"
using class_add_subtype class_add_sup_ty_opt
by(auto simp: sup_state_def Listn.le_def Product.le_def lesub_def class_add_widens
class_add_sup_ty_opt list_all2_mono)
lemma class_add_sup_state_opt:
"⟦ P ⊢ τ ≤' τ'; ¬ is_class P C ⟧
⟹ class_add P (C, cdec) ⊢ τ ≤' τ'"
by(auto simp: sup_state_opt_def Opt.le_def lesub_def class_add_widens
class_add_sup_ty_opt list_all2_mono)
subsection "Effect"
lemma class_add_is_relevant_class:
"⟦ is_relevant_class i P C⇩0; ¬ is_class P C ⟧
⟹ is_relevant_class i (class_add P (C, cdec)) C⇩0"
by(cases i, auto simp: class_add_subcls)
lemma class_add_is_relevant_class_rev:
assumes irc: "is_relevant_class i (class_add P (C, cdec)) C⇩0"
and ncp: "⋀cd D'. cd ∈ set P ⟹ ¬P ⊢ fst cd ≼⇧* C"
and wfxp: "wf_syscls P"
shows "is_relevant_class i P C⇩0"
using assms
proof(cases i)
case (Getfield F D) with assms
show ?thesis by(fastforce simp: wf_syscls_def sys_xcpts_def dest!: class_add_subcls_rev)
next
case (Putfield F D) with assms
show ?thesis by(fastforce simp: wf_syscls_def sys_xcpts_def dest!: class_add_subcls_rev)
next
case (Checkcast D) with assms
show ?thesis by(fastforce simp: wf_syscls_def sys_xcpts_def dest!: class_add_subcls_rev)
qed(simp_all)
lemma class_add_is_relevant_entry:
"⟦ is_relevant_entry P i pc e; ¬ is_class P C ⟧
⟹ is_relevant_entry (class_add P (C, cdec)) i pc e"
by(clarsimp simp: is_relevant_entry_def class_add_is_relevant_class)
lemma class_add_is_relevant_entry_rev:
"⟦ is_relevant_entry (class_add P (C, cdec)) i pc e;
⋀cd D'. cd ∈ set P ⟹ ¬P ⊢ fst cd ≼⇧* C;
wf_syscls P ⟧
⟹ is_relevant_entry P i pc e"
by(auto simp: is_relevant_entry_def dest!: class_add_is_relevant_class_rev)
lemma class_add_relevant_entries:
"¬ is_class P C
⟹ set (relevant_entries P i pc xt) ⊆ set (relevant_entries (class_add P (C, cdec)) i pc xt)"
by(clarsimp simp: relevant_entries_def class_add_is_relevant_entry)
lemma class_add_relevant_entries_eq:
assumes wf: "wf_prog wf_md P" and nclass: "¬ is_class P C"
shows "relevant_entries P i pc xt = relevant_entries (class_add P (C, cdec)) i pc xt"
proof -
have ncp: "⋀cd D'. cd ∈ set P ⟹ ¬P ⊢ fst cd ≼⇧* C"
by(rule wf_subcls_nCls'[OF assms])
moreover from wf have wfsys: "wf_syscls P" by(simp add: wf_prog_def)
moreover
note class_add_is_relevant_entry[OF _ nclass, of i pc _ cdec]
class_add_is_relevant_entry_rev[OF _ ncp wfsys, of cdec i pc]
ultimately show ?thesis by (metis filter_cong relevant_entries_def)
qed
lemma class_add_norm_eff_pc:
assumes ne: "∀(pc',τ') ∈ set (norm_eff i P pc τ). pc' < mpc"
shows "∀(pc',τ') ∈ set (norm_eff i (class_add P (C, cdec)) pc τ). pc' < mpc"
using assms by(cases i, auto simp: norm_eff_def)
lemma class_add_norm_eff_sup_state_opt:
assumes ne: "∀(pc',τ') ∈ set (norm_eff i P pc τ). P ⊢ τ' ≤' τs!pc'"
and nclass: "¬ is_class P C" and app: "app⇩i (i, P, pc, mxs, T, τ)"
shows "∀(pc',τ') ∈ set (norm_eff i (class_add P (C, cdec)) pc τ). (class_add P (C, cdec)) ⊢ τ' ≤' τs!pc'"
proof -
obtain ST LT where "τ = (ST,LT)" by(cases τ)
with assms show ?thesis proof(cases i)
qed(fastforce simp: norm_eff_def
dest!: class_add_field[where cdec=cdec] class_add_method[where cdec=cdec]
class_add_sup_loc[OF _ nclass] class_add_subtype[OF _ nclass]
class_add_widens[OF _ nclass] class_add_sup_state_opt[OF _ nclass])+
qed
lemma class_add_xcpt_eff_eq:
assumes wf: "wf_prog wf_md P" and nclass: "¬ is_class P C"
shows "xcpt_eff i P pc τ xt = xcpt_eff i (class_add P (C, cdec)) pc τ xt"
using class_add_relevant_entries_eq[OF assms, of i pc xt cdec] by(cases τ, simp add: xcpt_eff_def)
lemma class_add_eff_pc:
assumes eff: "∀(pc',τ') ∈ set (eff i P pc xt (Some τ)). pc' < mpc"
and wf: "wf_prog wf_md P" and nclass: "¬ is_class P C"
shows "∀(pc',τ') ∈ set (eff i (class_add P (C, cdec)) pc xt (Some τ)). pc' < mpc"
using eff class_add_norm_eff_pc class_add_xcpt_eff_eq[OF wf nclass]
by(auto simp: norm_eff_def eff_def)
lemma class_add_eff_sup_state_opt:
assumes eff: "∀(pc',τ') ∈ set (eff i P pc xt (Some τ)). P ⊢ τ' ≤' τs!pc'"
and wf: "wf_prog wf_md P"and nclass: "¬ is_class P C"
and app: "app⇩i (i, P, pc, mxs, T, τ)"
shows "∀(pc',τ') ∈ set (eff i (class_add P (C, cdec)) pc xt (Some τ)).
(class_add P (C, cdec)) ⊢ τ' ≤' τs!pc'"
proof -
from eff have ne: "∀(pc', τ')∈set (norm_eff i P pc τ). P ⊢ τ' ≤' τs ! pc'"
by(simp add: norm_eff_def eff_def)
from eff have "∀(pc', τ')∈set (xcpt_eff i P pc τ xt). P ⊢ τ' ≤' τs ! pc'"
by(simp add: xcpt_eff_def eff_def)
with class_add_norm_eff_sup_state_opt[OF ne nclass app]
class_add_xcpt_eff_eq[OF wf nclass]class_add_sup_state_opt[OF _ nclass]
show ?thesis by(cases cdec, auto simp: eff_def norm_eff_def xcpt_app_def)
qed
lemma class_add_app⇩i:
assumes "app⇩i (i, P, pc, mxs, T⇩r, ST, LT)" and "¬ is_class P C"
shows "app⇩i (i, class_add P (C, cdec), pc, mxs, T⇩r, ST, LT)"
using assms
proof(cases i)
case New then show ?thesis using assms by(fastforce simp: is_class_def class_def fun_upd_apply)
next
case Getfield then show ?thesis using assms
by(auto simp: class_add_subtype dest!: class_add_sees_field[where P=P])
next
case Getstatic then show ?thesis using assms by(auto dest!: class_add_sees_field[where P=P])
next
case Putfield then show ?thesis using assms
by(auto dest!: class_add_subtype[where P=P] class_add_sees_field[where P=P])
next
case Putstatic then show ?thesis using assms
by(auto dest!: class_add_subtype[where P=P] class_add_sees_field[where P=P])
next
case Checkcast then show ?thesis using assms
by(clarsimp simp: is_class_def class_def fun_upd_apply)
next
case Invoke then show ?thesis using assms
by(fastforce dest!: class_add_widens[where P=P] class_add_sees_method[where P=P])
next
case Invokestatic then show ?thesis using assms
by(fastforce dest!: class_add_widens[where P=P] class_add_sees_method[where P=P])
next
case Return then show ?thesis using assms by(clarsimp simp: class_add_subtype)
qed(simp+)
lemma class_add_xcpt_app:
assumes xa: "xcpt_app i P pc mxs xt τ"
and wf: "wf_prog wf_md P" and nclass: "¬ is_class P C"
shows "xcpt_app i (class_add P (C, cdec)) pc mxs xt τ"
using xa class_add_relevant_entries_eq[OF wf nclass] nclass
by(auto simp: xcpt_app_def is_class_def class_def fun_upd_apply) auto
lemma class_add_app:
assumes app: "app i P mxs T pc mpc xt t"
and wf: "wf_prog wf_md P" and nclass: "¬ is_class P C"
shows "app i (class_add P (C, cdec)) mxs T pc mpc xt t"
proof(cases t)
case (Some τ)
let ?P = "class_add P (C, cdec)"
from assms Some have eff: "∀(pc', τ')∈set (eff i P pc xt ⌊τ⌋). pc' < mpc" by(simp add: app_def)
from assms Some have app⇩i: "app⇩i (i,P,pc,mxs,T,τ)" by(simp add: app_def)
with class_add_app⇩i[OF _ nclass] Some have "app⇩i (i,?P,pc,mxs,T,τ)" by(cases τ,simp)
moreover
from app class_add_xcpt_app[OF _ wf nclass] Some
have "xcpt_app i ?P pc mxs xt τ" by(simp add: app_def del: xcpt_app_def)
moreover
from app class_add_eff_pc[OF eff wf nclass] Some
have "∀(pc',τ') ∈ set (eff i ?P pc xt t). pc' < mpc" by auto
moreover note app Some
ultimately show ?thesis by(simp add: app_def)
qed(simp)
subsection "Well-formedness and well-typedness"
lemma class_add_wf_mdecl:
"⟦ wf_mdecl wf_md P C⇩0 md;
⋀C⇩0 md. wf_md P C⇩0 md ⟹ wf_md (class_add P (C, cdec)) C⇩0 md ⟧
⟹ wf_mdecl wf_md (class_add P (C, cdec)) C⇩0 md"
by(clarsimp simp: wf_mdecl_def class_add_is_type)
lemma class_add_wf_mdecl':
assumes wfd: "wf_mdecl wf_md P C⇩0 md"
and ms: "(C⇩0,S,fs,ms) ∈ set P" and md: "md ∈ set ms"
and wf_md': "⋀C⇩0 S fs ms m.⟦(C⇩0,S,fs,ms) ∈ set P; m ∈ set ms⟧ ⟹ wf_md' (class_add P (C, cdec)) C⇩0 m"
shows "wf_mdecl wf_md' (class_add P (C, cdec)) C⇩0 md"
using assms by(clarsimp simp: wf_mdecl_def class_add_is_type)
lemma class_add_wf_cdecl:
assumes wfcd: "wf_cdecl wf_md P cd" and cdP: "cd ∈ set P"
and ncp: "¬ P ⊢ fst cd ≼⇧* C" and dist: "distinct_fst P"
and wfmd: "⋀C⇩0 md. wf_md P C⇩0 md ⟹ wf_md (class_add P (C, cdec)) C⇩0 md"
and nclass: "¬ is_class P C"
shows "wf_cdecl wf_md (class_add P (C, cdec)) cd"
proof -
let ?P = "class_add P (C, cdec)"
obtain C1 D fs ms where [simp]: "cd = (C1,(D,fs,ms))" by(cases cd)
from wfcd
have "∀f∈set fs. wf_fdecl ?P f" by(auto simp: wf_cdecl_def wf_fdecl_def class_add_is_type)
moreover
from wfcd wfmd class_add_wf_mdecl
have "∀m∈set ms. wf_mdecl wf_md ?P C1 m" by(auto simp: wf_cdecl_def)
moreover
have "C1 ≠ Object ⟹ is_class ?P D ∧ ¬ ?P ⊢ D ≼⇧* C1
∧ (∀(M,b,Ts,T,m)∈set ms.
∀D' b' Ts' T' m'. ?P ⊢ D sees M,b':Ts' → T' = m' in D' ⟶
b = b' ∧ ?P ⊢ Ts' [≤] Ts ∧ ?P ⊢ T ≤ T')"
proof -
assume nObj[simp]: "C1 ≠ Object"
with cdP dist have sub1: "P ⊢ C1 ≺⇧1 D" by(auto simp: class_def intro!: subcls1I map_of_SomeI)
with ncp have ncp': "¬ P ⊢ D ≼⇧* C" by(auto simp: converse_rtrancl_into_rtrancl)
with wfcd
have clsD: "is_class ?P D"
by(auto simp: wf_cdecl_def is_class_def class_def fun_upd_apply)
moreover
from wfcd sub1
have "¬ ?P ⊢ D ≼⇧* C1" by(auto simp: wf_cdecl_def dest!: class_add_subcls_rev[OF _ ncp'])
moreover
have "⋀M b Ts T m D' b' Ts' T' m'. (M,b,Ts,T,m) ∈ set ms
⟹ ?P ⊢ D sees M,b':Ts' → T' = m' in D'
⟹ b = b' ∧ ?P ⊢ Ts' [≤] Ts ∧ ?P ⊢ T ≤ T'"
proof -
fix M b Ts T m D' b' Ts' T' m'
assume ms: "(M,b,Ts,T,m) ∈ set ms" and meth': "?P ⊢ D sees M,b':Ts' → T' = m' in D'"
with sub1
have "P ⊢ D sees M,b':Ts' → T' = m' in D'"
by(fastforce dest!: class_add_sees_method_rev[OF _ ncp'])
moreover
with wfcd ms meth'
have "b = b' ∧ P ⊢ Ts' [≤] Ts ∧ P ⊢ T ≤ T'"
by(cases m', fastforce simp: wf_cdecl_def elim!: ballE[where x="(M,b,Ts,T,m)"])
ultimately show "b = b' ∧ ?P ⊢ Ts' [≤] Ts ∧ ?P ⊢ T ≤ T'"
by(auto dest!: class_add_subtype[OF _ nclass] class_add_widens[OF _ nclass])
qed
ultimately show ?thesis by clarsimp
qed
moreover note wfcd
ultimately show ?thesis by(simp add: wf_cdecl_def)
qed
lemma class_add_wf_cdecl':
assumes wfcd: "wf_cdecl wf_md P cd" and cdP: "cd ∈ set P"
and ncp: "¬P ⊢ fst cd ≼⇧* C" and dist: "distinct_fst P"
and wfmd: "⋀C⇩0 S fs ms m.⟦(C⇩0,S,fs,ms) ∈ set P; m ∈ set ms⟧ ⟹ wf_md' (class_add P (C, cdec)) C⇩0 m"
and nclass: "¬ is_class P C"
shows "wf_cdecl wf_md' (class_add P (C, cdec)) cd"
proof -
let ?P = "class_add P (C, cdec)"
obtain C1 D fs ms where [simp]: "cd = (C1,(D,fs,ms))" by(cases cd)
from wfcd
have "∀f∈set fs. wf_fdecl ?P f" by(auto simp: wf_cdecl_def wf_fdecl_def class_add_is_type)
moreover
from cdP wfcd wfmd
have "∀m∈set ms. wf_mdecl wf_md' ?P C1 m"
by(auto simp: wf_cdecl_def wf_mdecl_def class_add_is_type)
moreover
have "C1 ≠ Object ⟹ is_class ?P D ∧ ¬ ?P ⊢ D ≼⇧* C1
∧ (∀(M,b,Ts,T,m)∈set ms.
∀D' b' Ts' T' m'. ?P ⊢ D sees M,b':Ts' → T' = m' in D' ⟶
b = b' ∧ ?P ⊢ Ts' [≤] Ts ∧ ?P ⊢ T ≤ T')"
proof -
assume nObj[simp]: "C1 ≠ Object"
with cdP dist have sub1: "P ⊢ C1 ≺⇧1 D" by(auto simp: class_def intro!: subcls1I map_of_SomeI)
with ncp have ncp': "¬ P ⊢ D ≼⇧* C" by(auto simp: converse_rtrancl_into_rtrancl)
with wfcd
have clsD: "is_class ?P D"
by(auto simp: wf_cdecl_def is_class_def class_def fun_upd_apply)
moreover
from wfcd sub1
have "¬ ?P ⊢ D ≼⇧* C1" by(auto simp: wf_cdecl_def dest!: class_add_subcls_rev[OF _ ncp'])
moreover
have "⋀M b Ts T m D' b' Ts' T' m'. (M,b,Ts,T,m) ∈ set ms
⟹ ?P ⊢ D sees M,b':Ts' → T' = m' in D'
⟹ b = b' ∧ ?P ⊢ Ts' [≤] Ts ∧ ?P ⊢ T ≤ T'"
proof -
fix M b Ts T m D' b' Ts' T' m'
assume ms: "(M,b,Ts,T,m) ∈ set ms" and meth': "?P ⊢ D sees M,b':Ts' → T' = m' in D'"
with sub1
have "P ⊢ D sees M,b':Ts' → T' = m' in D'"
by(fastforce dest!: class_add_sees_method_rev[OF _ ncp'])
moreover
with wfcd ms meth'
have "b = b' ∧ P ⊢ Ts' [≤] Ts ∧ P ⊢ T ≤ T'"
by(cases m', fastforce simp: wf_cdecl_def elim!: ballE[where x="(M,b,Ts,T,m)"])
ultimately show "b = b' ∧ ?P ⊢ Ts' [≤] Ts ∧ ?P ⊢ T ≤ T'"
by(auto dest!: class_add_subtype[OF _ nclass] class_add_widens[OF _ nclass])
qed
ultimately show ?thesis by clarsimp
qed
moreover note wfcd
ultimately show ?thesis by(simp add: wf_cdecl_def)
qed
lemma class_add_wt_start:
"⟦ wt_start P C⇩0 b Ts mxl τs; ¬ is_class P C ⟧
⟹ wt_start (class_add P (C, cdec)) C⇩0 b Ts mxl τs"
using class_add_sup_state_opt by(clarsimp simp: wt_start_def split: staticb.splits)
lemma class_add_wt_instr:
assumes wti: "P,T,mxs,mpc,xt ⊢ i,pc :: τs"
and wf: "wf_prog wf_md P" and nclass: "¬ is_class P C"
shows "class_add P (C, cdec),T,mxs,mpc,xt ⊢ i,pc :: τs"
proof -
let ?P = "class_add P (C, cdec)"
from wti have eff: "∀(pc', τ')∈set (eff i P pc xt (τs ! pc)). P ⊢ τ' ≤' τs ! pc'"
by(simp add: wt_instr_def)
from wti have app⇩i: "τs!pc ≠ None ⟹ app⇩i (i,P,pc,mxs,T,the (τs!pc))"
by(simp add: wt_instr_def app_def)
from wti class_add_app[OF _ wf nclass]
have "app i ?P mxs T pc mpc xt (τs!pc)" by(simp add: wt_instr_def)
moreover
have "∀(pc',τ') ∈ set (eff i ?P pc xt (τs!pc)). ?P ⊢ τ' ≤' τs!pc'"
proof(cases "τs!pc")
case Some with eff class_add_eff_sup_state_opt[OF _ wf nclass app⇩i] show ?thesis by auto
qed(simp add: eff_def)
moreover note wti
ultimately show ?thesis by(clarsimp simp: wt_instr_def)
qed
lemma class_add_wt_method:
assumes wtm: "wt_method P C⇩0 b Ts T⇩r mxs mxl⇩0 is xt (Φ C⇩0 M⇩0)"
and wf: "wf_prog wf_md P" and nclass: "¬ is_class P C"
shows "wt_method (class_add P (C, cdec)) C⇩0 b Ts T⇩r mxs mxl⇩0 is xt (Φ C⇩0 M⇩0)"
proof -
let ?P = "class_add P (C, cdec)"
let ?τs = "Φ C⇩0 M⇩0"
from wtm class_add_check_types
have "check_types ?P mxs ((case b of Static ⇒ 0 | NonStatic ⇒ 1)+size Ts+mxl⇩0) (map OK ?τs)"
by(simp add: wt_method_def)
moreover
from wtm class_add_wt_start nclass
have "wt_start ?P C⇩0 b Ts mxl⇩0 ?τs" by(simp add: wt_method_def)
moreover
from wtm class_add_wt_instr[OF _ wf nclass]
have "∀pc < size is. ?P,T⇩r,mxs,size is,xt ⊢ is!pc,pc :: ?τs" by(clarsimp simp: wt_method_def)
moreover note wtm
ultimately
show ?thesis by(clarsimp simp: wt_method_def)
qed
lemma class_add_wt_method':
"⟦ (λP C (M,b,Ts,T⇩r,(mxs,mxl⇩0,is,xt)). wt_method P C b Ts T⇩r mxs mxl⇩0 is xt (Φ C M)) P C⇩0 md;
wf_prog wf_md P; ¬ is_class P C ⟧
⟹ (λP C (M,b,Ts,T⇩r,(mxs,mxl⇩0,is,xt)). wt_method P C b Ts T⇩r mxs mxl⇩0 is xt (Φ C M))
(class_add P (C, cdec)) C⇩0 md"
by(clarsimp simp: class_add_wt_method)
subsection ‹ @{text "distinct_fst"} ›
lemma class_add_distinct_fst:
"⟦ distinct_fst P; ¬ is_class P C ⟧
⟹ distinct_fst (class_add P (C, cdec))"
by(clarsimp simp: distinct_fst_def is_class_def class_def)
subsection "Conformance"
lemma class_add_conf:
"⟦ P,h ⊢ v :≤ T; ¬ is_class P C ⟧
⟹ class_add P (C, cdec),h ⊢ v :≤ T"
by(clarsimp simp: conf_def class_add_subtype)
lemma class_add_oconf:
fixes obj::obj
assumes oc: "P,h ⊢ obj √" and ns: "¬ is_class P C"
and ncp: "⋀D'. P ⊢ fst(obj) ≼⇧* D' ⟹ D' ≠ C"
shows "(class_add P (C, cdec)),h ⊢ obj √"
proof -
obtain C⇩0 fs where [simp]: "obj=(C⇩0,fs)" by(cases obj)
from oc have
oc': "⋀F D T. P ⊢ C⇩0 has F,NonStatic:T in D ⟹ (∃v. fs (F, D) = ⌊v⌋ ∧ P,h ⊢ v :≤ T)"
by(simp add: oconf_def)
have "⋀F D T. class_add P (C, cdec) ⊢ C⇩0 has F,NonStatic:T in D
⟹ ∃v. fs(F,D) = Some v ∧ class_add P (C, cdec),h ⊢ v :≤ T"
proof -
fix F D T assume "class_add P (C, cdec) ⊢ C⇩0 has F,NonStatic:T in D"
with class_add_has_field_rev[OF _ ncp] have meth: "P ⊢ C⇩0 has F,NonStatic:T in D" by simp
then show "∃v. fs(F,D) = Some v ∧ class_add P (C, cdec),h ⊢ v :≤ T"
using oc'[OF meth] class_add_conf[OF _ ns] by(fastforce simp: oconf_def)
qed
then show ?thesis by(simp add: oconf_def)
qed
lemma class_add_soconf:
assumes soc: "P,h,C⇩0 ⊢⇩s sfs √" and ns: "¬ is_class P C"
and ncp: "⋀D'. P ⊢ C⇩0 ≼⇧* D' ⟹ D' ≠ C"
shows "(class_add P (C, cdec)),h,C⇩0 ⊢⇩s sfs √"
proof -
from soc have
oc': "⋀F T. P ⊢ C⇩0 has F,Static:T in C⇩0 ⟹ (∃v. sfs F = ⌊v⌋ ∧ P,h ⊢ v :≤ T)"
by(simp add: soconf_def)
have "⋀F T. class_add P (C, cdec) ⊢ C⇩0 has F,Static:T in C⇩0
⟹ ∃v. sfs F = Some v ∧ class_add P (C, cdec),h ⊢ v :≤ T"
proof -
fix F T assume "class_add P (C, cdec) ⊢ C⇩0 has F,Static:T in C⇩0"
with class_add_has_field_rev[OF _ ncp] have meth: "P ⊢ C⇩0 has F,Static:T in C⇩0" by simp
then show "∃v. sfs F = Some v ∧ class_add P (C, cdec),h ⊢ v :≤ T"
using oc'[OF meth] class_add_conf[OF _ ns] by(fastforce simp: soconf_def)
qed
then show ?thesis by(simp add: soconf_def)
qed
lemma class_add_hconf:
assumes "P ⊢ h √" and "¬ is_class P C"
and "⋀a obj D'. h a = Some obj ⟹ P ⊢ fst(obj) ≼⇧* D' ⟹ D' ≠ C"
shows "class_add P (C, cdec) ⊢ h √"
using assms by(auto simp: hconf_def intro!: class_add_oconf)
lemma class_add_hconf_wf:
assumes wf: "wf_prog wf_md P" and "P ⊢ h √" and "¬ is_class P C"
and "⋀a obj. h a = Some obj ⟹ fst(obj) ≠ C"
shows "class_add P (C, cdec) ⊢ h √"
using wf_subcls_nCls[OF wf] assms by(fastforce simp: hconf_def intro!: class_add_oconf)
lemma class_add_shconf:
assumes "P,h ⊢⇩s sh √" and ns: "¬ is_class P C"
and "⋀C sobj D'. sh C = Some sobj ⟹ P ⊢ C ≼⇧* D' ⟹ D' ≠ C"
shows "class_add P (C, cdec),h ⊢⇩s sh √"
using assms by(fastforce simp: shconf_def)
lemma class_add_shconf_wf:
assumes wf: "wf_prog wf_md P" and "P,h ⊢⇩s sh √" and "¬ is_class P C"
and "⋀C sobj. sh C = Some sobj ⟹ C ≠ C"
shows "class_add P (C, cdec),h ⊢⇩s sh √"
using wf_subcls_nCls[OF wf] assms by(fastforce simp: shconf_def)
endTheory StartProg
section "Properties and types of the starting program"
theory StartProg
imports ClassAdd
begin
lemmas wt_defs = correct_state_def conf_f_def wt_instr_def eff_def norm_eff_def app_def xcpt_app_def
declare wt_defs [simp]
declare start_class_def [simp]
subsection "Types"
abbreviation start_φ⇩m :: "ty⇩m" where
"start_φ⇩m ≡ [Some([],[]),Some([Void],[])]"
fun Φ_start :: "ty⇩P ⇒ ty⇩P" where
"Φ_start Φ C M = (if C=Start ∧ (M=start_m ∨ M=clinit) then start_φ⇩m else Φ C M)"
lemma Φ_start: "⋀C. C ≠ Start ⟹ Φ_start Φ C = Φ C"
"Φ_start Φ Start start_m = start_φ⇩m" "Φ_start Φ Start clinit = start_φ⇩m"
by auto
lemma check_types_φ⇩m: "check_types (start_prog P C M) 1 0 (map OK start_φ⇩m)"
by (auto simp: check_types_def JVM_states_unfold)
subsection "Some simple properties"
lemma preallocated_start_state: "start_state P = σ ⟹ preallocated (fst(snd σ))"
using preallocated_start[of P] by(auto simp: start_state_def split_beta)
lemma start_prog_Start_super: "start_prog P C M ⊢ Start ≺⇧1 Object"
by(auto intro!: subcls1I simp: class_def fun_upd_apply)
lemma start_prog_Start_fields:
"start_prog P C M ⊢ Start has_fields FDTs ⟹ map_of FDTs (F, Start) = None"
by(drule Fields.cases, auto simp: class_def fun_upd_apply Object_fields)
lemma start_prog_Start_soconf:
"(start_prog P C M),h,Start ⊢⇩s Map.empty √"
by(simp add: soconf_def has_field_def start_prog_Start_fields)
lemma start_prog_start_shconf:
"start_prog P C M,start_heap P ⊢⇩s start_sheap √"
using start_prog_Start_soconf by (simp add: shconf_def fun_upd_apply)
subsection "Well-typed and well-formed"
lemma start_wt_method:
assumes "P ⊢ C sees M, Static : []→Void = m in D" and "M ≠ clinit" and "¬ is_class P Start"
shows "wt_method (start_prog P C M) Start Static [] Void 1 0 [Invokestatic C M 0, Return] [] start_φ⇩m"
(is "wt_method ?P ?C ?b ?Ts ?T⇩r ?mxs ?mxl⇩0 ?is ?xt ?τs")
proof -
let ?cdec = "(Object, [], [start_method C M, start_clinit])"
obtain mxs mxl ins xt where m: "m = (mxs,mxl,ins,xt)" by(cases m)
have ca_sees: "class_add P (Start, ?cdec) ⊢ C sees M, Static : []→Void = m in D"
by(rule class_add_sees_method[OF assms(1,3)])
have "⋀pc. pc < size ?is ⟹ ?P,?T⇩r,?mxs,size ?is,?xt ⊢ ?is!pc,pc :: ?τs"
proof -
fix pc assume pc: "pc < size ?is"
then show "?P,?T⇩r,?mxs,size ?is,?xt ⊢ ?is!pc,pc :: ?τs"
proof(cases "pc = 0")
case True with assms m ca_sees show ?thesis
by(fastforce simp: wt_method_def wt_start_def relevant_entries_def
is_relevant_entry_def xcpt_eff_def)
next
case False with pc show ?thesis
by(simp add: wt_method_def wt_start_def relevant_entries_def
is_relevant_entry_def xcpt_eff_def)
qed
qed
with assms check_types_φ⇩m show ?thesis by(simp add: wt_method_def wt_start_def)
qed
lemma start_clinit_wt_method:
assumes "P ⊢ C sees M, Static : []→Void = m in D" and "M ≠ clinit" and "¬ is_class P Start"
shows "wt_method (start_prog P C M) Start Static [] Void 1 0 [Push Unit,Return] [] start_φ⇩m"
(is "wt_method ?P ?C ?b ?Ts ?T⇩r ?mxs ?mxl⇩0 ?is ?xt ?τs")
proof -
let ?cdec = "(Object, [], [start_method C M, start_clinit])"
obtain mxs mxl ins xt where m: "m = (mxs,mxl,ins,xt)" by(cases m)
have ca_sees: "class_add P (Start, ?cdec) ⊢ C sees M, Static : []→Void = m in D"
by(rule class_add_sees_method[OF assms(1,3)])
have "⋀pc. pc < size ?is ⟹ ?P,?T⇩r,?mxs,size ?is,?xt ⊢ ?is!pc,pc :: ?τs"
proof -
fix pc assume pc: "pc < size ?is"
then show "?P,?T⇩r,?mxs,size ?is,?xt ⊢ ?is!pc,pc :: ?τs"
proof(cases "pc = 0")
case True with assms m ca_sees show ?thesis
by(fastforce simp: wt_method_def wt_start_def relevant_entries_def
is_relevant_entry_def xcpt_eff_def)
next
case False with pc show ?thesis
by(simp add: wt_method_def wt_start_def relevant_entries_def
is_relevant_entry_def xcpt_eff_def)
qed
qed
with assms check_types_φ⇩m show ?thesis by(simp add: wt_method_def wt_start_def)
qed
lemma start_class_wf:
assumes "P ⊢ C sees M, Static : []→Void = m in D"
and "M ≠ clinit" and "¬ is_class P Start"
and "Φ Start start_m = start_φ⇩m" and "Φ Start clinit = start_φ⇩m"
and "is_class P Object"
and "⋀b' Ts' T' m' D'. P ⊢ Object sees start_m, b' : Ts'→T' = m' in D'
⟹ b' = Static ∧ Ts' = [] ∧ T' = Void"
and "⋀b' Ts' T' m' D'. P ⊢ Object sees clinit, b' : Ts'→T' = m' in D'
⟹ b' = Static ∧ Ts' = [] ∧ T' = Void"
shows "wf_cdecl (λP C (M,b,Ts,T⇩r,(mxs,mxl⇩0,is,xt)). wt_method P C b Ts T⇩r mxs mxl⇩0 is xt (Φ C M))
(start_prog P C M) (start_class C M)"
proof -
from assms start_wt_method start_clinit_wt_method class_add_sees_method_rev_Obj[where P=P and C=Start]
show ?thesis
by(auto simp: start_method_def wf_cdecl_def wf_fdecl_def wf_mdecl_def
is_class_def class_def fun_upd_apply wf_clinit_def) fast+
qed
lemma start_prog_wf_jvm_prog_phi:
assumes wtp: "wf_jvm_prog⇘Φ⇙ P"
and nstart: "¬ is_class P Start"
and meth: "P ⊢ C sees M, Static : []→Void = m in D" and nclinit: "M ≠ clinit"
and Φ: "⋀C. C ≠ Start ⟹ Φ' C = Φ C"
and Φ': "Φ' Start start_m = start_φ⇩m" "Φ' Start clinit = start_φ⇩m"
and Obj_start_m: "⋀b' Ts' T' m' D'. P ⊢ Object sees start_m, b' : Ts'→T' = m' in D'
⟹ b' = Static ∧ Ts' = [] ∧ T' = Void"
shows "wf_jvm_prog⇘Φ'⇙ (start_prog P C M)"
proof -
let ?wf_md = "(λP C (M,b,Ts,T⇩r,(mxs,mxl⇩0,is,xt)). wt_method P C b Ts T⇩r mxs mxl⇩0 is xt (Φ C M))"
let ?wf_md' = "(λP C (M,b,Ts,T⇩r,(mxs,mxl⇩0,is,xt)). wt_method P C b Ts T⇩r mxs mxl⇩0 is xt (Φ' C M))"
from wtp have wf: "wf_prog ?wf_md P" by(simp add: wf_jvm_prog_phi_def)
from wf_subcls_nCls'[OF wf nstart]
have nsp: "⋀cd D'. cd ∈ set P ⟹ ¬P ⊢ fst cd ≼⇧* Start" by simp
have wf_md':
"⋀C⇩0 S fs ms m. (C⇩0, S, fs, ms) ∈ set P ⟹ m ∈ set ms ⟹ ?wf_md' (start_prog P C M) C⇩0 m"
proof -
fix C⇩0 S fs ms m assume asms: "(C⇩0, S, fs, ms) ∈ set P" "m ∈ set ms"
with nstart have ns: "C⇩0 ≠ Start" by(auto simp: is_class_def class_def dest: weak_map_of_SomeI)
from wf asms have "?wf_md P C⇩0 m" by(auto simp: wf_prog_def wf_cdecl_def wf_mdecl_def)
with Φ[OF ns] class_add_wt_method[OF _ wf nstart]
show "?wf_md' (start_prog P C M) C⇩0 m" by fastforce
qed
from wtp have a1: "is_class P Object" by (simp add: wf_jvm_prog_phi_def)
with wf_sees_clinit[where P=P and C=Object] wtp
have a2: "⋀b' Ts' T' m' D'. P ⊢ Object sees clinit, b' : Ts'→T' = m' in D'
⟹ b' = Static ∧ Ts' = [] ∧ T' = Void"
by(fastforce simp: wf_jvm_prog_phi_def is_class_def dest: sees_method_fun)
from wf have dist: "distinct_fst P" by (simp add: wf_prog_def)
with class_add_distinct_fst[OF _ nstart] have "distinct_fst (start_prog P C M)" by simp
moreover from wf have "wf_syscls (start_prog P C M)" by(simp add: wf_prog_def wf_syscls_def)
moreover
from class_add_wf_cdecl'[where wf_md'="?wf_md'", OF _ _ nsp dist] wf_md' nstart wf
have "⋀c. c ∈ set P ⟹ wf_cdecl ?wf_md' (start_prog P C M) c" by(fastforce simp: wf_prog_def)
moreover from start_class_wf[OF meth] nclinit nstart Φ' a1 Obj_start_m a2
have "wf_cdecl ?wf_md' (start_prog P C M) (start_class C M)" by simp
ultimately show ?thesis by(simp add: wf_jvm_prog_phi_def wf_prog_def)
qed
lemma start_prog_wf_jvm_prog:
assumes wf: "wf_jvm_prog P"
and nstart: "¬ is_class P Start"
and meth: "P ⊢ C sees M, Static : []→Void = m in D" and nclinit: "M ≠ clinit"
and Obj_start_m: "⋀b' Ts' T' m' D'. P ⊢ Object sees start_m, b' : Ts'→T' = m' in D'
⟹ b' = Static ∧ Ts' = [] ∧ T' = Void"
shows "wf_jvm_prog (start_prog P C M)"
proof -
from wf obtain Φ where wtp: "wf_jvm_prog⇘Φ⇙ P" by(clarsimp simp: wf_jvm_prog_def)
let ?Φ' = "λC f. if C = Start ∧ (f = start_m ∨ f = clinit) then start_φ⇩m else Φ C f"
from start_prog_wf_jvm_prog_phi[OF wtp nstart meth nclinit _ _ _ Obj_start_m] have
"wf_jvm_prog⇘?Φ'⇙ (start_prog P C M)" by simp
then show ?thesis by(auto simp: wf_jvm_prog_def)
qed
subsection "Methods and instructions"
lemma start_prog_Start_sees_methods:
"P ⊢ Object sees_methods Mm
⟹ start_prog P C M ⊢
Start sees_methods Mm ++ (map_option (λm. (m,Start)) ∘ map_of [start_method C M, start_clinit])"
by (auto simp: class_def fun_upd_apply
dest!: class_add_sees_methods_Obj[where P=P and C=Start] intro: sees_methods_rec)
lemma start_prog_Start_sees_start_method:
"P ⊢ Object sees_methods Mm
⟹ start_prog P C M ⊢
Start sees start_m, Static : []→Void = (1, 0, [Invokestatic C M 0,Return], []) in Start"
by(auto simp: start_method_def Method_def fun_upd_apply
dest!: start_prog_Start_sees_methods)
lemma wf_start_prog_Start_sees_start_method:
assumes wf: "wf_prog wf_md P"
shows "start_prog P C M ⊢
Start sees start_m, Static : []→Void = (1, 0, [Invokestatic C M 0,Return], []) in Start"
proof -
from wf have "is_class P Object" by simp
with sees_methods_Object obtain Mm where "P ⊢ Object sees_methods Mm"
by(fastforce simp: is_class_def dest: sees_methods_Object)
then show ?thesis by(rule start_prog_Start_sees_start_method)
qed
lemma start_prog_start_m_instrs:
assumes wf: "wf_prog wf_md P"
shows "(instrs_of (start_prog P C M) Start start_m) = [Invokestatic C M 0, Return]"
proof -
from wf_start_prog_Start_sees_start_method[OF wf]
have "start_prog P C M ⊢ Start sees start_m, Static :
[]→Void = (1,0,[Invokestatic C M 0,Return],[]) in Start" by simp
then show ?thesis by simp
qed
declare wt_defs [simp del]
endTheory BVSpecTypeSafe
section ‹ BV Type Safety Proof \label{sec:BVSpecTypeSafe} ›
theory BVSpecTypeSafe
imports BVConform StartProg
begin
text ‹
This theory contains proof that the specification of the bytecode
verifier only admits type safe programs.
›
subsection ‹ Preliminaries ›
text ‹
Simp and intro setup for the type safety proof:
›
lemmas defs1 = correct_state_def conf_f_def wt_instr_def eff_def norm_eff_def app_def xcpt_app_def
lemmas widen_rules [intro] = conf_widen confT_widen confs_widens confTs_widen
subsection ‹ Exception Handling ›
text ‹
For the @{text Invoke} instruction the BV has checked all handlers
that guard the current @{text pc}.
›
lemma Invoke_handlers:
"match_ex_table P C pc xt = Some (pc',d') ⟹
∃(f,t,D,h,d) ∈ set (relevant_entries P (Invoke n M) pc xt).
P ⊢ C ≼⇧* D ∧ pc ∈ {f..<t} ∧ pc' = h ∧ d' = d"
by (induct xt) (auto simp: relevant_entries_def matches_ex_entry_def
is_relevant_entry_def split: if_split_asm)
text ‹
For the @{text Invokestatic} instruction the BV has checked all handlers
that guard the current @{text pc}.
›
lemma Invokestatic_handlers:
"match_ex_table P C pc xt = Some (pc',d') ⟹
∃(f,t,D,h,d) ∈ set (relevant_entries P (Invokestatic C⇩0 n M) pc xt).
P ⊢ C ≼⇧* D ∧ pc ∈ {f..<t} ∧ pc' = h ∧ d' = d"
by (induct xt) (auto simp: relevant_entries_def matches_ex_entry_def
is_relevant_entry_def split: if_split_asm)
text ‹
For the instrs in @{text Called_set} the BV has checked all handlers
that guard the current @{text pc}.
›
lemma Called_set_handlers:
"match_ex_table P C pc xt = Some (pc',d') ⟹ i ∈ Called_set ⟹
∃(f,t,D,h,d) ∈ set (relevant_entries P i pc xt).
P ⊢ C ≼⇧* D ∧ pc ∈ {f..<t} ∧ pc' = h ∧ d' = d"
by (induct xt) (auto simp: relevant_entries_def matches_ex_entry_def
is_relevant_entry_def split: if_split_asm)
text ‹
We can prove separately that the recursive search for exception
handlers (@{text find_handler}) in the frame stack results in
a conforming state (if there was no matching exception handler
in the current frame). We require that the exception is a valid
heap address, and that the state before the exception occurred
conforms.
›
lemma uncaught_xcpt_correct:
assumes wt: "wf_jvm_prog⇘Φ⇙ P"
assumes h: "h xcp = Some obj"
shows "⋀f. P,Φ ⊢ (None, h, f#frs, sh)√
⟹ curr_method f ≠ clinit ⟹ P,Φ ⊢ find_handler P xcp h frs sh √"
(is "⋀f. ?correct (None, h, f#frs, sh) ⟹ ?prem f ⟹ ?correct (?find frs)")
proof (induct frs)
show "?correct (?find [])" by (simp add: correct_state_def)
next
from wt obtain mb where wf: "wf_prog mb P" by (simp add: wf_jvm_prog_phi_def)
fix f f' frs' assume cr: "?correct (None, h, f#f'#frs', sh)"
assume pr: "?prem f"
assume IH: "⋀f. ?correct (None, h, f#frs', sh) ⟹ ?prem f ⟹ ?correct (?find frs')"
from cr pr conf_clinit_Cons[where frs="f'#frs'" and f=f] obtain
confc: "conf_clinit P sh (f'#frs')"
and cr': "?correct (None, h, f'#frs', sh)" by(fastforce simp: correct_state_def)
obtain stk loc C M pc ics where [simp]: "f' = (stk,loc,C,M,pc,ics)" by (cases f')
from cr' obtain b Ts T mxs mxl⇩0 ins xt where
meth: "P ⊢ C sees M,b:Ts → T = (mxs,mxl⇩0,ins,xt) in C"
by (simp add: correct_state_def, blast)
hence xt[simp]: "ex_table_of P C M = xt" by simp
have cls: "is_class P C" by(rule sees_method_is_class'[OF meth])
from cr' obtain sfs where
sfs: "M = clinit ⟹ sh C = Some(sfs,Processing)" by(fastforce simp: defs1 conf_clinit_def)
show "?correct (?find (f'#frs'))"
proof (cases "match_ex_table P (cname_of h xcp) pc xt")
case None with cr' IH[of f'] show ?thesis
proof(cases "M=clinit")
case True then show ?thesis using xt cr' IH[of f'] None h conf_clinit_Called_Throwing
conf_f_Throwing[where h=h and sh=sh, OF _ cls h sfs]
by(cases frs', auto simp: correct_state_def image_iff) fastforce
qed(auto)
next
fix pc_d
assume "match_ex_table P (cname_of h xcp) pc xt = Some pc_d"
then obtain pc' d' where
match: "match_ex_table P (cname_of h xcp) pc xt = Some (pc',d')"
(is "?match (cname_of h xcp) = _")
by (cases pc_d) auto
from wt meth cr' [simplified]
have wti: "P,T,mxs,size ins,xt ⊢ ins!pc,pc :: Φ C M"
by (fastforce simp: correct_state_def conf_f_def
dest: sees_method_fun
elim!: wt_jvm_prog_impl_wt_instr)
from cr' obtain ST LT where Φ: "Φ C M ! pc = Some (ST, LT)"
by(fastforce dest: sees_method_fun simp: correct_state_def)
from cr' Φ meth have conf': "conf_f P h sh (ST, LT) ins f'"
by (unfold correct_state_def) (fastforce dest: sees_method_fun)
hence loc: "P,h ⊢ loc [:≤⇩⊤] LT" and
stk: "P,h ⊢ stk [:≤] ST" by (unfold conf_f_def) auto
hence [simp]: "size stk = size ST" by (simp add: list_all2_lengthD)
from cr meth pr
obtain D n M' where
ins: "ins!pc = Invoke n M' ∨ ins!pc = Invokestatic D n M'" (is "_ = ?i ∨ _ = ?i'")
by(fastforce dest: sees_method_fun simp: correct_state_def)
with match obtain f1 t D where
rel: "(f1,t,D,pc',d') ∈ set (relevant_entries P (ins!pc) pc xt)" and
D: "P ⊢ cname_of h xcp ≼⇧* D"
by(fastforce dest: Invoke_handlers Invokestatic_handlers)
from rel have
"(pc', Some (Class D # drop (size ST - d') ST, LT)) ∈ set (xcpt_eff (ins!pc) P pc (ST,LT) xt)"
(is "(_, Some (?ST',_)) ∈ _")
by (force simp: xcpt_eff_def image_def)
with wti Φ obtain
pc: "pc' < size ins" and
"P ⊢ Some (?ST', LT) ≤' Φ C M ! pc'"
by (clarsimp simp: defs1) blast
then obtain ST' LT' where
Φ': "Φ C M ! pc' = Some (ST',LT')" and
less: "P ⊢ (?ST', LT) ≤⇩i (ST',LT')"
by (auto simp: sup_state_opt_any_Some)
let ?f = "(Addr xcp # drop (length stk - d') stk, loc, C, M, pc',No_ics)"
have "conf_f P h sh (ST',LT') ins ?f"
proof -
from wf less loc have "P,h ⊢ loc [:≤⇩⊤] LT'" by simp blast
moreover from D h have "P,h ⊢ Addr xcp :≤ Class D"
by (simp add: conf_def obj_ty_def case_prod_unfold)
with less stk
have "P,h ⊢ Addr xcp # drop (length stk - d') stk [:≤] ST'"
by (auto intro!: list_all2_dropI)
ultimately show ?thesis using pc conf' by(auto simp: conf_f_def)
qed
with cr' match Φ' meth pc
show ?thesis by (unfold correct_state_def)
(cases "M=clinit"; fastforce dest: sees_method_fun simp: conf_clinit_def distinct_clinit_def)
qed
qed
text ‹
The requirement of lemma @{text uncaught_xcpt_correct} (that
the exception is a valid reference on the heap) is always met
for welltyped instructions and conformant states:
›
lemma exec_instr_xcpt_h:
"⟦ fst (exec_instr (ins!pc) P h stk vars C M pc ics frs sh) = Some xcp;
P,T,mxs,size ins,xt ⊢ ins!pc,pc :: Φ C M;
P,Φ ⊢ (None, h, (stk,loc,C,M,pc,ics)#frs, sh)√ ⟧
⟹ ∃obj. h xcp = Some obj"
(is "⟦ ?xcpt; ?wt; ?correct ⟧ ⟹ ?thesis")
proof -
note [simp] = split_beta
note [split] = if_split_asm option.split_asm
assume wt: ?wt ?correct
hence pre: "preallocated h" by (simp add: correct_state_def hconf_def)
assume xcpt: ?xcpt
with exec_instr_xcpts have
opt: "ins!pc = Throw ∨ xcp ∈ {a. ∃x ∈ sys_xcpts. a = addr_of_sys_xcpt x}" by simp
with pre show ?thesis
proof (cases "ins!pc")
case Throw with xcpt wt pre show ?thesis
by (clarsimp iff: list_all2_Cons2 simp: defs1)
(auto dest: non_npD simp: is_refT_def elim: preallocatedE)
qed (auto elim: preallocatedE)
qed
lemma exec_step_xcpt_h:
assumes xcpt: "fst (exec_step P h stk vars C M pc ics frs sh) = Some xcp"
and ins: "instrs_of P C M = ins"
and wti: "P,T,mxs,size ins,xt ⊢ ins!pc,pc :: Φ C M"
and correct: "P,Φ ⊢ (None, h, (stk,loc,C,M,pc,ics)#frs, sh)√"
shows "∃obj. h xcp = Some obj"
proof -
from correct have pre: "preallocated h" by(simp add: defs1 hconf_def)
{ fix C' Cs assume ics[simp]: "ics = Calling C' Cs"
with xcpt have "xcp = addr_of_sys_xcpt NoClassDefFoundError"
by(cases ics, auto simp: split_beta split: init_state.splits if_split_asm)
with pre have ?thesis using preallocated_def by force
}
moreover
{ fix Cs a assume [simp]: "ics = Throwing Cs a"
with xcpt have eq: "a = xcp" by(cases Cs; simp)
from correct have "P,h,sh ⊢⇩i (C,M,pc,ics)" by(auto simp: defs1)
with eq have ?thesis by simp
}
moreover
{ fix Cs assume ics: "ics = No_ics ∨ ics = Called Cs"
with exec_instr_xcpt_h[OF _ wti correct] xcpt ins have ?thesis by(cases Cs, auto)
}
ultimately show ?thesis by(cases ics, auto)
qed
lemma conf_sys_xcpt:
"⟦preallocated h; C ∈ sys_xcpts⟧ ⟹ P,h ⊢ Addr (addr_of_sys_xcpt C) :≤ Class C"
by (auto elim: preallocatedE)
lemma match_ex_table_SomeD:
"match_ex_table P C pc xt = Some (pc',d') ⟹
∃(f,t,D,h,d) ∈ set xt. matches_ex_entry P C pc (f,t,D,h,d) ∧ h = pc' ∧ d=d'"
by (induct xt) (auto split: if_split_asm)
text ‹
Finally we can state that, whenever an exception occurs, the
next state always conforms:
›
lemma xcpt_correct:
fixes σ' :: jvm_state
assumes wtp: "wf_jvm_prog⇘Φ⇙ P"
assumes meth: "P ⊢ C sees M,b:Ts→T=(mxs,mxl⇩0,ins,xt) in C"
assumes wt: "P,T,mxs,size ins,xt ⊢ ins!pc,pc :: Φ C M"
assumes xp: "fst (exec_step P h stk loc C M pc ics frs sh) = Some xcp"
assumes s': "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
assumes correct: "P,Φ ⊢ (None, h, (stk,loc,C,M,pc,ics)#frs, sh)√"
shows "P,Φ ⊢ σ'√"
proof -
from wtp obtain wfmb where wf: "wf_prog wfmb P"
by (simp add: wf_jvm_prog_phi_def)
from meth have ins[simp]: "instrs_of P C M = ins" by simp
have cls: "is_class P C" by(rule sees_method_is_class[OF meth])
from correct obtain sfs where
sfs: "M = clinit ⟹ sh C = Some(sfs,Processing)"
by(auto simp: correct_state_def conf_clinit_def conf_f_def2)
note conf_sys_xcpt [elim!]
note xp' = meth s' xp
from correct meth
obtain ST LT where
h_ok: "P ⊢ h √" and
sh_ok: "P,h ⊢⇩s sh √" and
Φ_pc: "Φ C M ! pc = Some (ST, LT)" and
frame: "conf_f P h sh (ST,LT) ins (stk,loc,C,M,pc,ics)" and
frames: "conf_fs P h sh Φ C M (size Ts) T frs" and
confc: "conf_clinit P sh ((stk,loc,C,M,pc,ics)#frs)" and
vics: "P,h,sh ⊢⇩i (C,M,pc,ics)"
by(auto simp: defs1 dest: sees_method_fun)
from frame obtain
stk: "P,h ⊢ stk [:≤] ST" and
loc: "P,h ⊢ loc [:≤⇩⊤] LT" and
pc: "pc < size ins"
by (unfold conf_f_def) auto
from h_ok have preh: "preallocated h" by (simp add: hconf_def)
note wtp
moreover
from exec_step_xcpt_h[OF xp ins wt correct]
obtain obj where h: "h xcp = Some obj" by clarify
moreover note correct
ultimately
have fh: "curr_method (stk,loc,C,M,pc,ics) ≠ clinit
⟹ P,Φ ⊢ find_handler P xcp h frs sh √" by (rule uncaught_xcpt_correct)
with xp'
have "M ≠ clinit ⟹ ∀Cs a. ics ≠ Throwing Cs a
⟹ match_ex_table P (cname_of h xcp) pc xt = None ⟹ ?thesis"
(is "?nc ⟹ ?t ⟹ ?m (cname_of h xcp) = _ ⟹ _" is "?nc ⟹ ?t ⟹ ?match = _ ⟹ _")
by(cases ics; simp add: split_beta)
moreover
from correct xp' conf_clinit_Called_Throwing conf_f_Throwing[where h=h and sh=sh, OF _ cls h sfs]
have "M = clinit ⟹ ∀Cs a. ics ≠ Throwing Cs a
⟹ match_ex_table P (cname_of h xcp) pc xt = None ⟹ ?thesis"
by(cases frs, auto simp: correct_state_def image_iff split_beta) fastforce
moreover
{ fix pc_d assume "?match = Some pc_d"
then obtain pc' d' where some_handler: "?match = Some (pc',d')"
by (cases pc_d) auto
from stk have [simp]: "size stk = size ST" ..
from wt Φ_pc have
eff: "∀(pc', s')∈set (xcpt_eff (ins!pc) P pc (ST,LT) xt).
pc' < size ins ∧ P ⊢ s' ≤' Φ C M!pc'"
by (auto simp: defs1)
from some_handler obtain f t D where
xt: "(f,t,D,pc',d') ∈ set xt" and
"matches_ex_entry P (cname_of h xcp) pc (f,t,D,pc',d')"
by (auto dest: match_ex_table_SomeD)
hence match: "P ⊢ cname_of h xcp ≼⇧* D" "pc ∈ {f..<t}"
by (auto simp: matches_ex_entry_def)
{ fix C' Cs assume ics: "ics = Calling C' Cs ∨ ics = Called (C'#Cs)"
let ?stk' = "Addr xcp # drop (length stk - d') stk"
let ?f = "(?stk', loc, C, M, pc', No_ics)"
from some_handler xp' ics
have σ': "σ' = (None, h, ?f#frs, sh)"
by (cases ics; simp add: split_beta)
from xp ics have "xcp = addr_of_sys_xcpt NoClassDefFoundError"
by(cases ics, auto simp: split_beta split: init_state.splits if_split_asm)
with match preh have conf: "P,h ⊢ Addr xcp :≤ Class D" by fastforce
from correct ics obtain C1 where "Called_context P C1 (ins!pc)"
by(fastforce simp: correct_state_def conf_f_def2)
then have "ins!pc ∈ Called_set" by(rule Called_context_Called_set)
with xt match have "(f,t,D,pc',d') ∈ set (relevant_entries P (ins!pc) pc xt)"
by(auto simp: relevant_entries_def is_relevant_entry_def)
with eff obtain ST' LT' where
Φ_pc': "Φ C M ! pc' = Some (ST', LT')" and
pc': "pc' < size ins" and
less: "P ⊢ (Class D # drop (size ST - d') ST, LT) ≤⇩i (ST', LT')"
by (fastforce simp: xcpt_eff_def sup_state_opt_any_Some)
with conf loc stk conf_f_def2 frame ics have "conf_f P h sh (ST',LT') ins ?f"
by (auto simp: defs1 intro: list_all2_dropI)
with meth h_ok frames Φ_pc' σ' sh_ok confc ics
have ?thesis
by (unfold correct_state_def)
(auto dest: sees_method_fun conf_clinit_diff' sees_method_is_class; fastforce)
}
moreover
{ assume ics: "ics = No_ics ∨ ics = Called []"
let ?stk' = "Addr xcp # drop (length stk - d') stk"
let ?f = "(?stk', loc, C, M, pc', No_ics)"
from some_handler xp' ics
have σ': "σ' = (None, h, ?f#frs, sh)"
by (cases ics; simp add: split_beta)
from xp ics obtain
"(f,t,D,pc',d') ∈ set (relevant_entries P (ins!pc) pc xt)" and
conf: "P,h ⊢ Addr xcp :≤ Class D"
proof (cases "ins!pc")
case Return
with xp ics have False by(cases ics; cases frs, auto simp: split_beta split: if_split_asm)
then show ?thesis by simp
next
case New with xp match
have "is_relevant_entry P (ins!pc) pc (f,t,D,pc',d')"
by (simp add: is_relevant_entry_def)
moreover
from xp wt correct obtain obj where xcp: "h xcp = Some obj"
by (blast dest: exec_step_xcpt_h[OF _ ins])
ultimately
show ?thesis using xt match
by (auto simp: relevant_entries_def conf_def case_prod_unfold intro: that)
next
case Getfield with xp ics
have xcp: "xcp = addr_of_sys_xcpt NullPointer ∨ xcp = addr_of_sys_xcpt NoSuchFieldError
∨ xcp = addr_of_sys_xcpt IncompatibleClassChangeError"
by (cases ics; simp add: split_beta split: if_split_asm staticb.splits)
with Getfield match preh have "is_relevant_entry P (ins!pc) pc (f,t,D,pc',d')"
by (fastforce simp: is_relevant_entry_def)
with match preh xt xcp
show ?thesis by(fastforce simp: relevant_entries_def intro: that)
next
case Getstatic with xp match
have "is_relevant_entry P (ins!pc) pc (f,t,D,pc',d')"
by (simp add: is_relevant_entry_def)
moreover
from xp wt correct obtain obj where xcp: "h xcp = Some obj"
by (blast dest: exec_step_xcpt_h[OF _ ins])
ultimately
show ?thesis using xt match
by (auto simp: relevant_entries_def conf_def case_prod_unfold intro: that)
next
case Putfield with xp ics
have xcp: "xcp = addr_of_sys_xcpt NullPointer ∨ xcp = addr_of_sys_xcpt NoSuchFieldError
∨ xcp = addr_of_sys_xcpt IncompatibleClassChangeError"
by (cases ics; simp add: split_beta split: if_split_asm staticb.splits)
with Putfield match preh have "is_relevant_entry P (ins!pc) pc (f,t,D,pc',d')"
by (fastforce simp: is_relevant_entry_def)
with match preh xt xcp
show ?thesis by (fastforce simp: relevant_entries_def intro: that)
next
case Putstatic with xp match
have "is_relevant_entry P (ins!pc) pc (f,t,D,pc',d')"
by (simp add: is_relevant_entry_def)
moreover
from xp wt correct obtain obj where xcp: "h xcp = Some obj"
by (blast dest: exec_step_xcpt_h[OF _ ins])
ultimately
show ?thesis using xt match
by (auto simp: relevant_entries_def conf_def case_prod_unfold intro: that)
next
case Checkcast with xp ics
have [simp]: "xcp = addr_of_sys_xcpt ClassCast"
by (cases ics; simp add: split_beta split: if_split_asm)
with Checkcast match preh have "is_relevant_entry P (ins!pc) pc (f,t,D,pc',d')"
by (simp add: is_relevant_entry_def)
with match preh xt
show ?thesis by (fastforce simp: relevant_entries_def intro: that)
next
case Invoke with xp match
have "is_relevant_entry P (ins!pc) pc (f,t,D,pc',d')"
by (simp add: is_relevant_entry_def)
moreover
from xp wt correct obtain obj where xcp: "h xcp = Some obj"
by (blast dest: exec_step_xcpt_h[OF _ ins])
ultimately
show ?thesis using xt match
by (auto simp: relevant_entries_def conf_def case_prod_unfold intro: that)
next
case Invokestatic with xp match
have "is_relevant_entry P (ins!pc) pc (f,t,D,pc',d')"
by (simp add: is_relevant_entry_def)
moreover
from xp wt correct obtain obj where xcp: "h xcp = Some obj"
by (blast dest: exec_step_xcpt_h[OF _ ins])
ultimately
show ?thesis using xt match
by (auto simp: relevant_entries_def conf_def case_prod_unfold intro: that)
next
case Throw with xp match preh
have "is_relevant_entry P (ins!pc) pc (f,t,D,pc',d')"
by (simp add: is_relevant_entry_def)
moreover
from xp wt correct obtain obj where xcp: "h xcp = Some obj"
by (blast dest: exec_step_xcpt_h[OF _ ins])
ultimately
show ?thesis using xt match
by (auto simp: relevant_entries_def conf_def case_prod_unfold intro: that)
qed(cases ics, (auto)[5])+
with eff obtain ST' LT' where
Φ_pc': "Φ C M ! pc' = Some (ST', LT')" and
pc': "pc' < size ins" and
less: "P ⊢ (Class D # drop (size ST - d') ST, LT) ≤⇩i (ST', LT')"
by (fastforce simp: xcpt_eff_def sup_state_opt_any_Some)
with conf loc stk conf_f_def2 frame ics have "conf_f P h sh (ST',LT') ins ?f"
by (auto simp: defs1 intro: list_all2_dropI)
with meth h_ok frames Φ_pc' σ' sh_ok confc ics
have ?thesis
by (unfold correct_state_def) (auto dest: sees_method_fun conf_clinit_diff'; fastforce)
}
ultimately
have "∀Cs a. ics ≠ Throwing Cs a ⟹ ?thesis" by(cases ics; metis list.exhaust)
}
moreover
{ fix Cs a assume "ics = Throwing Cs a"
with xp' have ics: "ics = Throwing [] xcp" by(cases Cs; clarsimp)
let ?frs = "(stk,loc,C,M,pc,No_ics)#frs"
have eT: "exec_step P h stk loc C M pc (Throwing [] xcp) frs sh = (Some xcp, h, ?frs, sh)"
by auto
with xp' ics have σ'_fh: "σ' = find_handler P xcp h ?frs sh" by simp
from meth have [simp]: "xt = ex_table_of P C M" by simp
let ?match = "match_ex_table P (cname_of h xcp) pc xt"
{ assume clinit: "M = clinit" and None: "?match = None"
note asms = clinit None
have "P,Φ |- find_handler P xcp h ?frs sh [ok]"
proof(cases frs)
case Nil
with h_ok sh_ok asms show "P,Φ |- find_handler P xcp h ?frs sh [ok]"
by(simp add: correct_state_def)
next
case [simp]: (Cons f' frs')
obtain stk' loc' C' M' pc' ics' where
[simp]: "f' = (stk',loc',C',M',pc',ics')" by(cases f')
have cls: "is_class P C" by(rule sees_method_is_class[OF meth])
have shC: "sh C = Some(sfs,Processing)" by(rule sfs[OF clinit])
from correct obtain b Ts T mxs' mxl⇩0' ins' xt' ST' LT' where
meth': "P ⊢ C' sees M', b : Ts→T = (mxs', mxl⇩0', ins', xt') in C'" and
Φ_pc': "Φ C' M' ! pc' = ⌊(ST', LT')⌋" and
frame': "conf_f P h sh (ST',LT') ins' (stk', loc', C', M', pc', ics')" and
frames': "conf_fs P h sh Φ C' M' (length Ts) T frs'" and
confc': "conf_clinit P sh ((stk',loc',C',M',pc',ics')#frs')"
by(auto dest: conf_clinit_Cons simp: correct_state_def)
from meth' have
ins'[simp]: "instrs_of P C' M' = ins'"
and [simp]: "xt' = ex_table_of P C' M'" by simp+
let ?f' = "case ics' of Called Cs' ⇒ (stk',loc',C',M',pc',Throwing (C#Cs') xcp)
| _ ⇒ (stk',loc',C',M',pc',ics')"
from asms confc have confc_T: "conf_clinit P sh (?f'#frs')"
by(cases ics', auto simp: conf_clinit_def distinct_clinit_def)
from asms conf_f_Throwing[where h=h and sh=sh, OF _ cls h shC] frame' have
frame_T: "conf_f P h sh (ST', LT') ins' ?f'" by(cases ics'; simp)
with h_ok sh_ok meth' Φ_pc' confc_T frames'
have "P,Φ |- (None, h, ?f'#frs', sh) [ok]"
by(cases ics') (fastforce simp: correct_state_def)+
with asms show ?thesis by(cases ics'; simp)
qed
}
moreover
{ assume asms: "M ≠ clinit" "?match = None"
from asms uncaught_xcpt_correct[OF wtp h correct]
have "P,Φ |- find_handler P xcp h frs sh [ok]" by simp
with asms have "P,Φ |- find_handler P xcp h ?frs sh [ok]" by auto
}
moreover
{ fix pc_d assume some_handler: "?match = ⌊pc_d⌋"
(is "?match = ⌊pc_d⌋")
then obtain pc1 d1 where sh': "?match = Some(pc1,d1)" by(cases pc_d, simp)
let ?stk' = "Addr xcp # drop (length stk - d1) stk"
let ?f = "(?stk', loc, C, M, pc1, No_ics)"
from stk have [simp]: "size stk = size ST" ..
from wt Φ_pc have
eff: "∀(pc1, s')∈set (xcpt_eff (ins!pc) P pc (ST,LT) xt).
pc1 < size ins ∧ P ⊢ s' ≤' Φ C M!pc1"
by (auto simp: defs1)
from match_ex_table_SomeD[OF sh'] obtain f t D where
xt: "(f,t,D,pc1,d1) ∈ set xt" and
"matches_ex_entry P (cname_of h xcp) pc (f,t,D,pc1,d1)" by auto
hence match: "P ⊢ cname_of h xcp ≼⇧* D" "pc ∈ {f..<t}"
by (auto simp: matches_ex_entry_def)
from ics vics obtain C1 where "Called_context P C1 (ins ! pc)" by auto
then have "ins!pc ∈ Called_set" by(rule Called_context_Called_set)
with match xt xp ics obtain
res: "(f,t,D,pc1,d1) ∈ set (relevant_entries P (ins!pc) pc xt)"
by(auto simp: relevant_entries_def is_relevant_entry_def)
with h match xt xp ics have conf: "P,h ⊢ Addr xcp :≤ Class D"
by (auto simp: relevant_entries_def conf_def case_prod_unfold)
with eff res obtain ST1 LT1 where
Φ_pc1: "Φ C M ! pc1 = Some (ST1, LT1)" and
pc1: "pc1 < size ins" and
less1: "P ⊢ (Class D # drop (size ST - d1) ST, LT) ≤⇩i (ST1, LT1)"
by (fastforce simp: xcpt_eff_def sup_state_opt_any_Some)
with conf loc stk conf_f_def2 frame ics have frame1: "conf_f P h sh (ST1,LT1) ins ?f"
by (auto simp: defs1 intro: list_all2_dropI)
from Φ_pc1 h_ok sh_ok meth frame1 frames conf_clinit_diff'[OF confc] have
"P,Φ |- (None, h, ?f # frs, sh) [ok]" by(fastforce simp: correct_state_def)
with sh' have "P,Φ |- find_handler P xcp h ?frs sh [ok]" by auto
}
ultimately
have cr': "P,Φ |- find_handler P xcp h ?frs sh [ok]" by(cases "?match") blast+
with σ'_fh have ?thesis by simp
}
ultimately
show ?thesis by (cases "?match") blast+
qed
declare defs1 [simp]
subsection ‹ Initialization procedure steps ›
text ‹
In this section we prove that, for states that result in a step of the
initialization procedure rather than an instruction execution, the state
after execution of the step still conforms.
›
lemma Calling_correct:
fixes σ' :: jvm_state
assumes wtprog: "wf_jvm_prog⇘Φ⇙ P"
assumes mC: "P ⊢ C sees M,b:Ts→T=(mxs,mxl⇩0,ins,xt) in C"
assumes s': "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
assumes cf: "P,Φ ⊢ (None, h, (stk,loc,C,M,pc,ics)#frs, sh)√"
assumes xc: "fst (exec_step P h stk loc C M pc ics frs sh) = None"
assumes ics: "ics = Calling C' Cs"
shows "P,Φ ⊢ σ'√"
proof -
from wtprog obtain wfmb where wf: "wf_prog wfmb P"
by (simp add: wf_jvm_prog_phi_def)
from mC cf obtain ST LT where
h_ok: "P ⊢ h √" and
sh_ok: "P,h ⊢⇩s sh √" and
Φ: "Φ C M ! pc = Some (ST,LT)" and
stk: "P,h ⊢ stk [:≤] ST" and loc: "P,h ⊢ loc [:≤⇩⊤] LT" and
pc: "pc < size ins" and
frame: "conf_f P h sh (ST, LT) ins (stk,loc,C,M,pc,ics)" and
fs: "conf_fs P h sh Φ C M (size Ts) T frs" and
confc: "conf_clinit P sh ((stk,loc,C,M,pc,ics)#frs)" and
vics: "P,h,sh ⊢⇩i (C,M,pc,ics)"
by (fastforce dest: sees_method_fun)
with ics have confc⇩0: "conf_clinit P sh ((stk,loc,C,M,pc,Calling C' Cs)#frs)" by simp
from vics ics have cls': "is_class P C'" by auto
{ assume None: "sh C' = None"
let ?sh = "sh(C' ↦ (sblank P C', Prepared))"
obtain FDTs where
flds: "P ⊢ C' has_fields FDTs" using wf_Fields_Ex[OF wf cls'] by clarsimp
from shconf_upd_obj[where C=C', OF sh_ok soconf_sblank[OF flds]]
have sh_ok': "P,h ⊢⇩s ?sh √" by simp
from None have "∀sfs. sh C' ≠ Some(sfs,Processing)" by simp
with conf_clinit_nProc_dist[OF confc] have
dist': "distinct (C' # clinit_classes ((stk, loc, C, M, pc, ics) # frs))" by simp
then have dist'': "distinct (C' # clinit_classes frs)" by simp
have confc': "conf_clinit P ?sh ((stk, loc, C, M, pc, ics) # frs)"
by(rule conf_clinit_shupd[OF confc dist'])
have fs': "conf_fs P h ?sh Φ C M (size Ts) T frs" by(rule conf_fs_shupd[OF fs dist''])
from vics ics have vics': "P,h,?sh ⊢⇩i (C, M, pc, ics)" by auto
from s' ics None have "σ' = (None, h, (stk, loc, C, M, pc, ics)#frs, ?sh)" by auto
with mC h_ok sh_ok' Φ stk loc pc fs' confc vics' confc' frame None
have ?thesis by fastforce
}
moreover
{ fix a assume "sh C' = Some a"
then obtain sfs i where shC'[simp]: "sh C' = Some(sfs,i)" by(cases a, simp)
from confc ics have last: "∃sobj. sh (last(C'#Cs)) = Some sobj"
by(fastforce simp: conf_clinit_def)
let "?f" = "λics'. (stk, loc, C, M, pc, ics'::init_call_status)"
{ assume i: "i = Done ∨ i = Processing"
let ?ics = "Called Cs"
from last vics ics have vics': "P,h,sh ⊢⇩i (C, M, pc, ?ics)" by auto
from confc ics have confc': "conf_clinit P sh (?f ?ics#frs)"
by(cases "M=clinit"; clarsimp simp: conf_clinit_def distinct_clinit_def)
from i s' ics have "σ' = (None, h, ?f ?ics#frs, sh)" by auto
with mC h_ok sh_ok Φ stk loc pc fs confc' vics' frame ics
have ?thesis by fastforce
}
moreover
{ assume i[simp]: "i = Error"
let ?a = "addr_of_sys_xcpt NoClassDefFoundError"
let ?ics = "Throwing Cs ?a"
from h_ok have preh: "preallocated h" by (simp add: hconf_def)
then obtain obj where ha: "h ?a = Some obj" by(clarsimp simp: preallocated_def sys_xcpts_def)
with vics ics have vics': "P,h,sh ⊢⇩i (C, M, pc, ?ics)" by auto
from confc ics have confc'': "conf_clinit P sh (?f ?ics#frs)"
by(cases "M=clinit"; clarsimp simp: conf_clinit_def distinct_clinit_def)
from s' ics have σ': "σ' = (None, h, ?f ?ics#frs, sh)" by auto
from mC h_ok sh_ok Φ stk loc pc fs confc'' vics σ' ics ha
have ?thesis by fastforce
}
moreover
{ assume i[simp]: "i = Prepared"
let ?sh = "sh(C' ↦ (sfs,Processing))"
let ?D = "fst(the(class P C'))"
let ?ics = "if C' = Object then Called (C'#Cs) else Calling ?D (C'#Cs)"
from shconf_upd_obj[where C=C', OF sh_ok shconfD[OF sh_ok shC']]
have sh_ok': "P,h ⊢⇩s ?sh √" by simp
from cls' have "C' ≠ Object ⟹ P ⊢ C' ≼⇧* ?D" by(auto simp: is_class_def intro!: subcls1I)
with is_class_supclass[OF wf _ cls'] have D: "C' ≠ Object ⟹ is_class P ?D" by simp
from i have "∀sfs. sh C' ≠ Some(sfs,Processing)" by simp
with conf_clinit_nProc_dist[OF confc⇩0] have
dist': "distinct (C' # clinit_classes ((stk, loc, C, M, pc, Calling C' Cs) # frs))" by fast
then have dist'': "distinct (C' # clinit_classes frs)" by simp
from conf_clinit_shupd_Calling[OF confc⇩0 dist' cls']
conf_clinit_shupd_Called[OF confc⇩0 dist' cls']
have confc': "conf_clinit P ?sh (?f ?ics#frs)" by clarsimp
with last ics have "∃sobj. ?sh (last(C'#Cs)) = Some sobj"
by(auto simp: conf_clinit_def fun_upd_apply)
with D vics ics have vics': "P,h,?sh ⊢⇩i (C, M, pc, ?ics)" by auto
have fs': "conf_fs P h ?sh Φ C M (size Ts) T frs" by(rule conf_fs_shupd[OF fs dist''])
from frame vics' have frame': "conf_f P h ?sh (ST, LT) ins (?f ?ics)" by simp
from i s' ics have "σ' = (None, h, ?f ?ics#frs, ?sh)" by(auto simp: if_split_asm)
with mC h_ok sh_ok' Φ stk loc pc fs' confc' frame' ics
have ?thesis by fastforce
}
ultimately have ?thesis by(cases i, auto)
}
ultimately show ?thesis by(cases "sh C'", auto)
qed
lemma Throwing_correct:
fixes σ' :: jvm_state
assumes wtprog: "wf_jvm_prog⇘Φ⇙ P"
assumes mC: "P ⊢ C sees M,b:Ts→T=(mxs,mxl⇩0,ins,xt) in C"
assumes s': "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
assumes cf: "P,Φ ⊢ (None, h, (stk,loc,C,M,pc,ics)#frs, sh)√"
assumes xc: "fst (exec_step P h stk loc C M pc ics frs sh) = None"
assumes ics: "ics = Throwing (C'#Cs) a"
shows "P,Φ ⊢ σ'√"
proof -
from wtprog obtain wfmb where wf: "wf_prog wfmb P"
by (simp add: wf_jvm_prog_phi_def)
from mC cf obtain ST LT where
h_ok: "P ⊢ h √" and
sh_ok: "P,h ⊢⇩s sh √" and
Φ: "Φ C M ! pc = Some (ST,LT)" and
stk: "P,h ⊢ stk [:≤] ST" and loc: "P,h ⊢ loc [:≤⇩⊤] LT" and
pc: "pc < size ins" and
frame: "conf_f P h sh (ST, LT) ins (stk,loc,C,M,pc,ics)" and
fs: "conf_fs P h sh Φ C M (size Ts) T frs" and
confc: "conf_clinit P sh ((stk,loc,C,M,pc,ics)#frs)" and
vics: "P,h,sh ⊢⇩i (C,M,pc,ics)"
by (fastforce dest: sees_method_fun)
with ics have confc⇩0: "conf_clinit P sh ((stk,loc,C,M,pc,Throwing (C'#Cs) a)#frs)" by simp
from frame ics mC have
cc: "∃C1. Called_context P C1 (ins ! pc)" by(clarsimp simp: conf_f_def2)
from frame ics obtain obj where ha: "h a = Some obj" by(auto simp: conf_f_def2)
from confc ics obtain sfs i where shC': "sh C' = Some(sfs,i)" by(clarsimp simp: conf_clinit_def)
then have sfs: "P,h,C' ⊢⇩s sfs √" by(rule shconfD[OF sh_ok])
from s' ics
have σ': "σ' = (None, h, (stk,loc,C,M,pc,Throwing Cs a)#frs, sh(C' ↦ (fst(the(sh C')), Error)))"
(is "σ' = (None, h, ?f'#frs, ?sh')")
by simp
from confc ics have dist: "distinct (C' # clinit_classes (?f' # frs))"
by (simp add: conf_clinit_def distinct_clinit_def)
then have dist': "distinct (C' # clinit_classes frs)" by simp
from conf_clinit_Throwing confc ics have confc': "conf_clinit P sh (?f' # frs)" by simp
from shconf_upd_obj[OF sh_ok sfs] shC' have "P,h ⊢⇩s ?sh' √" by simp
moreover
have "conf_fs P h ?sh' Φ C M (length Ts) T frs" by(rule conf_fs_shupd[OF fs dist'])
moreover
have "conf_clinit P ?sh' (?f' # frs)" by(rule conf_clinit_shupd[OF confc' dist])
moreover note σ' h_ok mC Φ pc stk loc ha cc
ultimately show "P,Φ ⊢ σ' √" by fastforce
qed
lemma Called_correct:
fixes σ' :: jvm_state
assumes wtprog: "wf_jvm_prog⇘Φ⇙ P"
assumes mC: "P ⊢ C sees M,b:Ts→T=(mxs,mxl⇩0,ins,xt) in C"
assumes s': "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
assumes cf: "P,Φ ⊢ (None, h, (stk,loc,C,M,pc,ics)#frs, sh)√"
assumes xc: "fst (exec_step P h stk loc C M pc ics frs sh) = None"
assumes ics[simp]: "ics = Called (C'#Cs)"
shows "P,Φ ⊢ σ'√"
proof -
from wtprog obtain wfmb where wf: "wf_prog wfmb P"
by (simp add: wf_jvm_prog_phi_def)
from mC cf obtain ST LT where
h_ok: "P ⊢ h √" and
sh_ok: "P,h ⊢⇩s sh √" and
Φ: "Φ C M ! pc = Some (ST,LT)" and
stk: "P,h ⊢ stk [:≤] ST" and loc: "P,h ⊢ loc [:≤⇩⊤] LT" and
pc: "pc < size ins" and
frame: "conf_f P h sh (ST, LT) ins (stk,loc,C,M,pc,ics)" and
fs: "conf_fs P h sh Φ C M (size Ts) T frs" and
confc: "conf_clinit P sh ((stk,loc,C,M,pc,ics)#frs)" and
vics: "P,h,sh ⊢⇩i (C,M,pc,ics)"
by (fastforce dest: sees_method_fun)
then have confc⇩0: "conf_clinit P sh ((stk,loc,C,M,pc,Called (C'#Cs))#frs)" by simp
from frame mC obtain C1 sobj where
ss: "Called_context P C1 (ins ! pc)" and
shC1: "sh C1 = Some sobj" by(clarsimp simp: conf_f_def2)
from confc wf_sees_clinit[OF wf] obtain mxs' mxl' ins' xt' where
clinit: "P ⊢ C' sees clinit,Static: [] → Void=(mxs',mxl',ins',xt') in C'"
by(fastforce simp: conf_clinit_def is_class_def)
let ?loc' = "replicate mxl' undefined"
from s' clinit
have σ': "σ' = (None, h, ([],?loc',C',clinit,0,No_ics)#(stk,loc,C,M,pc,Called Cs)#frs, sh)"
(is "σ' = (None, h, ?if#?f'#frs, sh)")
by simp
with wtprog clinit
obtain start: "wt_start P C' Static [] mxl' (Φ C' clinit)" and ins': "ins' ≠ []"
by (auto dest: wt_jvm_prog_impl_wt_start)
then obtain LT⇩0 where LT⇩0: "Φ C' clinit ! 0 = Some ([], LT⇩0)"
by (clarsimp simp: wt_start_def defs1 sup_state_opt_any_Some split: staticb.splits)
moreover
have "conf_f P h sh ([], LT⇩0) ins' ?if"
proof -
let ?LT = "replicate mxl' Err"
have "P,h ⊢ ?loc' [:≤⇩⊤] ?LT" by simp
also from start LT⇩0 have "P ⊢ … [≤⇩⊤] LT⇩0" by (simp add: wt_start_def)
finally have "P,h ⊢ ?loc' [:≤⇩⊤] LT⇩0" .
thus ?thesis using ins' by simp
qed
moreover
from conf_clinit_Called confc clinit have "conf_clinit P sh (?if # ?f' # frs)" by simp
moreover note σ' h_ok sh_ok mC Φ pc stk loc clinit ss shC1 fs
ultimately show "P,Φ ⊢ σ' √" by fastforce
qed
subsection ‹ Single Instructions ›
text ‹
In this section we prove for each single (welltyped) instruction
that the state after execution of the instruction still conforms.
Since we have already handled exceptions above, we can now assume that
no exception occurs in this step. For instructions that may call
the initialization procedure, we cover the calling and non-calling
cases separately.
›
lemma Invoke_correct:
fixes σ' :: jvm_state
assumes wtprog: "wf_jvm_prog⇘Φ⇙ P"
assumes meth_C: "P ⊢ C sees M,b:Ts→T=(mxs,mxl⇩0,ins,xt) in C"
assumes ins: "ins ! pc = Invoke M' n"
assumes wti: "P,T,mxs,size ins,xt ⊢ ins!pc,pc :: Φ C M"
assumes σ': "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
assumes approx: "P,Φ ⊢ (None, h, (stk,loc,C,M,pc,ics)#frs, sh)√"
assumes no_xcp: "fst (exec_step P h stk loc C M pc ics frs sh) = None"
shows "P,Φ ⊢ σ'√"
proof -
from meth_C approx ins have [simp]: "ics = No_ics" by(cases ics, auto)
note split_paired_Ex [simp del]
from wtprog obtain wfmb where wfprog: "wf_prog wfmb P"
by (simp add: wf_jvm_prog_phi_def)
from ins meth_C approx obtain ST LT where
heap_ok: "P⊢ h√" and
Φ_pc: "Φ C M!pc = Some (ST,LT)" and
frame: "conf_f P h sh (ST,LT) ins (stk,loc,C,M,pc,ics)" and
frames: "conf_fs P h sh Φ C M (size Ts) T frs" and
confc: "conf_clinit P sh ((stk,loc,C,M,pc,ics)#frs)"
by (fastforce dest: sees_method_fun)
from ins wti Φ_pc
have n: "n < size ST" by simp
{ assume "stk!n = Null"
with ins no_xcp meth_C have False by (simp add: split_beta)
hence ?thesis ..
}
moreover
{ assume "ST!n = NT"
moreover
from frame have "P,h ⊢ stk [:≤] ST" by simp
with n have "P,h ⊢ stk!n :≤ ST!n" by (simp add: list_all2_conv_all_nth)
ultimately
have "stk!n = Null" by simp
with ins no_xcp meth_C have False by (simp add: split_beta)
hence ?thesis ..
}
moreover {
assume NT: "ST!n ≠ NT" and Null: "stk!n ≠ Null"
from NT ins wti Φ_pc obtain D D' b Ts T m ST' LT' where
D: "ST!n = Class D" and
pc': "pc+1 < size ins" and
m_D: "P ⊢ D sees M',b: Ts→T = m in D'" and
Ts: "P ⊢ rev (take n ST) [≤] Ts" and
Φ': "Φ C M ! (pc+1) = Some (ST', LT')" and
LT': "P ⊢ LT [≤⇩⊤] LT'" and
ST': "P ⊢ (T # drop (n+1) ST) [≤] ST'" and
b[simp]: "b = NonStatic"
by (clarsimp simp: sup_state_opt_any_Some)
from frame obtain
stk: "P,h ⊢ stk [:≤] ST" and
loc: "P,h ⊢ loc [:≤⇩⊤] LT" by simp
from n stk D have "P,h ⊢ stk!n :≤ Class D"
by (auto simp: list_all2_conv_all_nth)
with Null obtain a C' fs where
Addr: "stk!n = Addr a" and
obj: "h a = Some (C',fs)" and
C'subD: "P ⊢ C' ≼⇧* D"
by (fastforce dest!: conf_ClassD)
with wfprog m_D no_xcp
obtain Ts' T' D'' mxs' mxl' ins' xt' where
m_C': "P ⊢ C' sees M',NonStatic: Ts'→T' = (mxs',mxl',ins',xt') in D''" and
T': "P ⊢ T' ≤ T" and
Ts': "P ⊢ Ts [≤] Ts'"
by (auto dest: sees_method_mono)
with wf_NonStatic_nclinit wtprog have nclinit: "M' ≠ clinit" by(simp add: wf_jvm_prog_phi_def)
have D''subD': "P ⊢ D'' ≼⇧* D'" by(rule sees_method_decl_mono[OF C'subD m_D m_C'])
let ?loc' = "Addr a # rev (take n stk) @ replicate mxl' undefined"
let ?f' = "([], ?loc', D'', M', 0, No_ics)"
let ?f = "(stk, loc, C, M, pc, ics)"
from Addr obj m_C' ins σ' meth_C no_xcp
have s': "σ' = (None, h, ?f' # ?f # frs, sh)" by simp
from Ts n have [simp]: "size Ts = n"
by (auto dest: list_all2_lengthD simp: min_def)
with Ts' have [simp]: "size Ts' = n"
by (auto dest: list_all2_lengthD)
from m_C' wfprog
obtain mD'': "P ⊢ D'' sees M',NonStatic:Ts'→T'=(mxs',mxl',ins',xt') in D''"
by (fast dest: sees_method_idemp)
moreover
with wtprog
obtain start: "wt_start P D'' NonStatic Ts' mxl' (Φ D'' M')" and ins': "ins' ≠ []"
by (auto dest: wt_jvm_prog_impl_wt_start)
then obtain LT⇩0 where LT⇩0: "Φ D'' M' ! 0 = Some ([], LT⇩0)"
by (clarsimp simp: wt_start_def defs1 sup_state_opt_any_Some split: staticb.splits)
moreover
have "conf_f P h sh ([], LT⇩0) ins' ?f'"
proof -
let ?LT = "OK (Class D'') # (map OK Ts') @ (replicate mxl' Err)"
from stk have "P,h ⊢ take n stk [:≤] take n ST" ..
hence "P,h ⊢ rev (take n stk) [:≤] rev (take n ST)" by simp
also note Ts also note Ts' finally
have "P,h ⊢ rev (take n stk) [:≤⇩⊤] map OK Ts'" by simp
also
have "P,h ⊢ replicate mxl' undefined [:≤⇩⊤] replicate mxl' Err"
by simp
also from m_C' have "P ⊢ C' ≼⇧* D''" by (rule sees_method_decl_above)
with obj have "P,h ⊢ Addr a :≤ Class D''" by (simp add: conf_def)
ultimately
have "P,h ⊢ ?loc' [:≤⇩⊤] ?LT" by simp
also from start LT⇩0 have "P ⊢ … [≤⇩⊤] LT⇩0" by (simp add: wt_start_def)
finally have "P,h ⊢ ?loc' [:≤⇩⊤] LT⇩0" .
thus ?thesis using ins' nclinit by simp
qed
moreover
have "conf_clinit P sh (?f'#?f#frs)" using conf_clinit_Invoke[OF confc nclinit] by simp
ultimately
have ?thesis using s' Φ_pc approx meth_C m_D T' ins D nclinit D''subD'
by(fastforce dest: sees_method_fun [of _ C])
}
ultimately show ?thesis by blast
qed
lemma Invokestatic_nInit_correct:
fixes σ' :: jvm_state
assumes wtprog: "wf_jvm_prog⇘Φ⇙ P"
assumes meth_C: "P ⊢ C sees M,b:Ts→T=(mxs,mxl⇩0,ins,xt) in C"
assumes ins: "ins ! pc = Invokestatic D M' n" and nclinit: "M' ≠ clinit"
assumes wti: "P,T,mxs,size ins,xt ⊢ ins!pc,pc :: Φ C M"
assumes σ': "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
assumes approx: "P,Φ ⊢ (None, h, (stk,loc,C,M,pc,ics)#frs, sh)√"
assumes no_xcp: "fst (exec_step P h stk loc C M pc ics frs sh) = None"
assumes cs: "ics = Called [] ∨ (ics = No_ics ∧ (∃sfs. sh (fst(method P D M')) = Some(sfs, Done)))"
shows "P,Φ ⊢ σ'√"
proof -
note split_paired_Ex [simp del]
from wtprog obtain wfmb where wfprog: "wf_prog wfmb P"
by (simp add: wf_jvm_prog_phi_def)
from ins meth_C approx obtain ST LT where
heap_ok: "P⊢ h√" and
Φ_pc: "Φ C M!pc = Some (ST,LT)" and
frame: "conf_f P h sh (ST,LT) ins (stk,loc,C,M,pc,ics)" and
frames: "conf_fs P h sh Φ C M (size Ts) T frs" and
confc: "conf_clinit P sh ((stk,loc,C,M,pc,ics)#frs)"
by (fastforce dest: sees_method_fun)
from ins wti Φ_pc have n: "n ≤ size ST" by simp
from ins wti Φ_pc obtain D' b Ts T mxs' mxl' ins' xt' ST' LT' where
pc': "pc+1 < size ins" and
m_D: "P ⊢ D sees M',b: Ts→T = (mxs',mxl',ins',xt') in D'" and
Ts: "P ⊢ rev (take n ST) [≤] Ts" and
Φ': "Φ C M ! (pc+1) = Some (ST', LT')" and
LT': "P ⊢ LT [≤⇩⊤] LT'" and
ST': "P ⊢ (T # drop n ST) [≤] ST'" and
b[simp]: "b = Static"
by (clarsimp simp: sup_state_opt_any_Some)
from frame obtain
stk: "P,h ⊢ stk [:≤] ST" and
loc: "P,h ⊢ loc [:≤⇩⊤] LT" by simp
let ?loc' = "rev (take n stk) @ replicate mxl' undefined"
let ?f' = "([], ?loc', D', M', 0, No_ics)"
let ?f = "(stk, loc, C, M, pc, No_ics)"
from m_D ins σ' meth_C no_xcp cs
have s': "σ' = (None, h, ?f' # ?f # frs, sh)" by auto
from Ts n have [simp]: "size Ts = n"
by (auto dest: list_all2_lengthD)
from m_D wfprog b
obtain mD': "P ⊢ D' sees M',Static:Ts→T=(mxs',mxl',ins',xt') in D'"
by (fast dest: sees_method_idemp)
moreover
with wtprog
obtain start: "wt_start P D' Static Ts mxl' (Φ D' M')" and ins': "ins' ≠ []"
by (auto dest: wt_jvm_prog_impl_wt_start)
then obtain LT⇩0 where LT⇩0: "Φ D' M' ! 0 = Some ([], LT⇩0)"
by (clarsimp simp: wt_start_def defs1 sup_state_opt_any_Some split: staticb.splits)
moreover
have "conf_f P h sh ([], LT⇩0) ins' ?f'"
proof -
let ?LT = "(map OK Ts) @ (replicate mxl' Err)"
from stk have "P,h ⊢ take n stk [:≤] take n ST" ..
hence "P,h ⊢ rev (take n stk) [:≤] rev (take n ST)" by simp
also note Ts finally
have "P,h ⊢ rev (take n stk) [:≤⇩⊤] map OK Ts" by simp
also
have "P,h ⊢ replicate mxl' undefined [:≤⇩⊤] replicate mxl' Err"
by simp
also from m_D have "P ⊢ D ≼⇧* D'" by (rule sees_method_decl_above)
ultimately
have "P,h ⊢ ?loc' [:≤⇩⊤] ?LT" by simp
also from start LT⇩0 have "P ⊢ … [≤⇩⊤] LT⇩0" by (simp add: wt_start_def)
finally have "P,h ⊢ ?loc' [:≤⇩⊤] LT⇩0" .
thus ?thesis using ins' by simp
qed
moreover
have "conf_clinit P sh (?f'#?f#frs)" by(rule conf_clinit_Invoke[OF confc nclinit])
ultimately
show ?thesis using s' Φ_pc approx meth_C m_D ins nclinit
by (fastforce dest: sees_method_fun [of _ C])
qed
lemma Invokestatic_Init_correct:
fixes σ' :: jvm_state
assumes wtprog: "wf_jvm_prog⇘Φ⇙ P"
assumes meth_C: "P ⊢ C sees M,b:Ts→T=(mxs,mxl⇩0,ins,xt) in C"
assumes ins: "ins ! pc = Invokestatic D M' n" and nclinit: "M' ≠ clinit"
assumes wti: "P,T,mxs,size ins,xt ⊢ ins!pc,pc :: Φ C M"
assumes σ': "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,No_ics)#frs, sh)"
assumes approx: "P,Φ ⊢ (None, h, (stk,loc,C,M,pc,No_ics)#frs, sh)√"
assumes no_xcp: "fst (exec_step P h stk loc C M pc No_ics frs sh) = None"
assumes nDone: "∀sfs. sh (fst(method P D M')) ≠ Some(sfs, Done)"
shows "P,Φ ⊢ σ'√"
proof -
note split_paired_Ex [simp del]
from wtprog obtain wfmb where wfprog: "wf_prog wfmb P"
by (simp add: wf_jvm_prog_phi_def)
from ins meth_C approx obtain ST LT where
heap_ok: "P⊢ h√" and
Φ_pc: "Φ C M!pc = Some (ST,LT)" and
stk: "P,h ⊢ stk [:≤] ST" and loc: "P,h ⊢ loc [:≤⇩⊤] LT" and
pc: "pc < size ins" and
frames: "conf_fs P h sh Φ C M (size Ts) T frs" and
confc: "conf_clinit P sh ((stk,loc,C,M,pc,No_ics)#frs)" and
pc: "pc < size ins"
by (fastforce dest: sees_method_fun)
from ins wti Φ_pc obtain D' b Ts T mxs' mxl' ins' xt' where
m_D: "P ⊢ D sees M',b: Ts→T = (mxs',mxl',ins',xt') in D'" and
b[simp]: "b = Static"
by clarsimp
let ?f = "(stk, loc, C, M, pc, Calling D' [])"
from m_D ins σ' meth_C no_xcp nDone
have s': "σ' = (None, h, ?f # frs, sh)" by(auto split: init_state.splits)
have cls: "is_class P D'" by(rule sees_method_is_class'[OF m_D])
from confc have confc': "conf_clinit P sh (?f#frs)"
by(auto simp: conf_clinit_def distinct_clinit_def split: if_split_asm)
with s' Φ_pc approx meth_C m_D ins nclinit stk loc pc cls frames
show ?thesis by(fastforce dest: sees_method_fun [of _ C])
qed
declare list_all2_Cons2 [iff]
lemma Return_correct:
fixes σ' :: jvm_state
assumes wt_prog: "wf_jvm_prog⇘Φ⇙ P"
assumes meth: "P ⊢ C sees M,b:Ts→T=(mxs,mxl⇩0,ins,xt) in C"
assumes ins: "ins ! pc = Return"
assumes wt: "P,T,mxs,size ins,xt ⊢ ins!pc,pc :: Φ C M"
assumes s': "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
assumes correct: "P,Φ ⊢ (None, h, (stk,loc,C,M,pc,ics)#frs, sh)√"
shows "P,Φ ⊢ σ'√"
proof -
from meth correct ins have [simp]: "ics = No_ics" by(cases ics, auto)
from wt_prog
obtain wfmb where wf: "wf_prog wfmb P" by (simp add: wf_jvm_prog_phi_def)
from meth ins s'
have "frs = [] ⟹ ?thesis" by (simp add: correct_state_def)
moreover
{ fix f frs' assume frs': "frs = f#frs'"
then obtain stk' loc' C' M' pc' ics' where
f: "f = (stk',loc',C',M',pc',ics')" by (cases f)
from correct meth
obtain ST LT where
h_ok: "P ⊢ h √" and
sh_ok: "P,h ⊢⇩s sh √" and
Φ_pc: "Φ C M ! pc = Some (ST, LT)" and
frame: "conf_f P h sh (ST, LT) ins (stk,loc,C,M,pc,ics)" and
frames: "conf_fs P h sh Φ C M (size Ts) T frs" and
confc: "conf_clinit P sh frs"
by (auto dest: sees_method_fun conf_clinit_Cons simp: correct_state_def)
from Φ_pc ins wt
obtain U ST⇩0 where "ST = U # ST⇩0" "P ⊢ U ≤ T"
by (simp add: wt_instr_def app_def) blast
with wf frame
have hd_stk: "P,h ⊢ hd stk :≤ T" by (auto simp: conf_f_def)
from f frs' frames meth
obtain ST' LT' b' Ts'' T'' mxs' mxl⇩0' ins' xt' where
Φ': "Φ C' M' ! pc' = Some (ST', LT')" and
meth_C': "P ⊢ C' sees M',b':Ts''→T''=(mxs',mxl⇩0',ins',xt') in C'" and
frame': "conf_f P h sh (ST',LT') ins' f" and
conf_fs: "conf_fs P h sh Φ C' M' (size Ts'') T'' frs'"
by clarsimp
from f frame' obtain
stk': "P,h ⊢ stk' [:≤] ST'" and
loc': "P,h ⊢ loc' [:≤⇩⊤] LT'" and
pc': "pc' < size ins'"
by (simp add: conf_f_def)
{ assume b[simp]: "b = NonStatic"
from wf_NonStatic_nclinit[OF wf] meth have nclinit[simp]: "M ≠ clinit" by simp
from f frs' meth ins s'
have σ':
"σ' = (None,h,(hd stk#(drop (1+size Ts) stk'),loc',C',M',pc'+1,ics')#frs',sh)"
(is "σ' = (None,h,?f'#frs',sh)")
by simp
from f frs' confc conf_clinit_diff have confc'': "conf_clinit P sh (?f'#frs')" by blast
with Φ' meth_C' f frs' frames meth
obtain D Ts' T' m D' where
ins': "ins' ! pc' = Invoke M (size Ts)" and
D: "ST' ! (size Ts) = Class D" and
meth_D: "P ⊢ D sees M,b: Ts'→T' = m in D'" and
T': "P ⊢ T ≤ T'" and
CsubD': "P ⊢ C ≼⇧* D'"
by(auto dest: sees_method_fun sees_method_fun[OF sees_method_idemp])
from wt_prog meth_C' pc'
have "P,T'',mxs',size ins',xt' ⊢ ins'!pc',pc' :: Φ C' M'"
by (rule wt_jvm_prog_impl_wt_instr)
with ins' Φ' D meth_D
obtain ST'' LT'' where
Φ_suc: "Φ C' M' ! Suc pc' = Some (ST'', LT'')" and
less: "P ⊢ (T' # drop (size Ts+1) ST', LT') ≤⇩i (ST'', LT'')" and
suc_pc': "Suc pc' < size ins'"
by (clarsimp simp: sup_state_opt_any_Some)
from hd_stk T' have hd_stk': "P,h ⊢ hd stk :≤ T'" ..
have frame'':
"conf_f P h sh (ST'',LT'') ins' ?f'"
proof -
from stk'
have "P,h ⊢ drop (1+size Ts) stk' [:≤] drop (1+size Ts) ST'" ..
moreover
with hd_stk' less
have "P,h ⊢ hd stk # drop (1+size Ts) stk' [:≤] ST''" by auto
moreover
from wf loc' less have "P,h ⊢ loc' [:≤⇩⊤] LT''" by auto
moreover note suc_pc'
moreover
from f frs' frames
have "P,h,sh ⊢⇩i (C', M', Suc pc', ics')" by auto
ultimately show ?thesis by (simp add: conf_f_def)
qed
with σ' frs' f meth h_ok sh_ok hd_stk Φ_suc frames confc'' meth_C' Φ'
have ?thesis by(fastforce dest: sees_method_fun [of _ C'])
}
moreover
{ assume b[simp]: "b = Static" and nclinit[simp]: "M ≠ clinit"
from f frs' meth ins s'
have σ':
"σ' = (None,h,(hd stk#(drop (size Ts) stk'),loc',C',M',pc'+1,ics')#frs',sh)"
(is "σ' = (None,h,?f'#frs',sh)")
by simp
from f frs' confc conf_clinit_diff have confc'': "conf_clinit P sh (?f'#frs')" by blast
with Φ' meth_C' f frs' frames meth
obtain D Ts' T' m where
ins': "ins' ! pc' = Invokestatic D M (size Ts)" and
meth_D: "P ⊢ D sees M,b: Ts'→T' = m in C" and
T': "P ⊢ T ≤ T'"
by(auto dest: sees_method_fun sees_method_mono2[OF _ wf sees_method_idemp])
from wt_prog meth_C' pc'
have "P,T'',mxs',size ins',xt' ⊢ ins'!pc',pc' :: Φ C' M'"
by (rule wt_jvm_prog_impl_wt_instr)
with ins' Φ' meth_D
obtain ST'' LT'' where
Φ_suc: "Φ C' M' ! Suc pc' = Some (ST'', LT'')" and
less: "P ⊢ (T' # drop (size Ts) ST', LT') ≤⇩i (ST'', LT'')" and
suc_pc': "Suc pc' < size ins'"
by (clarsimp simp: sup_state_opt_any_Some)
from hd_stk T' have hd_stk': "P,h ⊢ hd stk :≤ T'" ..
have frame'':
"conf_f P h sh (ST'',LT'') ins' ?f'"
proof -
from stk'
have "P,h ⊢ drop (size Ts) stk' [:≤] drop (size Ts) ST'" ..
moreover
with hd_stk' less
have "P,h ⊢ hd stk # drop (size Ts) stk' [:≤] ST''" by auto
moreover
from wf loc' less have "P,h ⊢ loc' [:≤⇩⊤] LT''" by auto
moreover note suc_pc'
moreover
from f frs' frames
have "P,h,sh ⊢⇩i (C', M', Suc pc', ics')" by auto
ultimately show ?thesis by (simp add: conf_f_def)
qed
with σ' frs' f meth h_ok sh_ok hd_stk Φ_suc frames confc'' meth_C' Φ'
have ?thesis by(fastforce dest: sees_method_fun [of _ C'])
}
moreover
{ assume b[simp]: "b = Static" and clinit[simp]: "M = clinit"
from frs' meth ins s'
have σ':
"σ' = (None,h,frs,sh(C↦(fst(the(sh C)), Done)))" (is "σ' = (None,h,frs,?sh)")
by simp
from correct have dist': "distinct (C # clinit_classes frs)"
by(simp add: conf_clinit_def distinct_clinit_def)
from f frs' correct have confc1:
"conf_clinit P sh ((stk, loc, C, clinit, pc, No_ics) # (stk',loc',C',M',pc',ics') # frs')"
by simp
then have ics_dist: "distinct (C # ics_classes ics')"
by(simp add: conf_clinit_def distinct_clinit_def)
from conf_clinit_Cons_Cons[OF confc1] have dist'': "distinct (C # clinit_classes frs')"
by(simp add: conf_clinit_def distinct_clinit_def)
from correct shconf_upd_obj[OF sh_ok _ [OF shconfD[OF sh_ok]]]
have sh'_ok: "P,h ⊢⇩s ?sh √" by(clarsimp simp: conf_clinit_def)
have frame'':
"conf_f P h ?sh (ST',LT') ins' f"
proof -
note stk' loc' pc' f valid_ics_shupd[OF _ ics_dist]
moreover
from f frs' frames
have "P,h,sh ⊢⇩i (C', M', pc', ics')" by auto
ultimately show ?thesis by (simp add: conf_f_def2)
qed
have conf_fs': "conf_fs P h ?sh Φ C' M' (length Ts'') T'' frs'"
by(rule conf_fs_shupd[OF conf_fs dist''])
have confc'': "conf_clinit P ?sh frs" by(rule conf_clinit_shupd[OF confc dist'])
from σ' f frs' h_ok sh'_ok conf_fs' frame'' Φ' stk' loc' pc' meth_C' confc''
have ?thesis by(fastforce dest: sees_method_fun)
}
ultimately have ?thesis by (cases b) blast+
}
ultimately
show ?thesis by (cases frs) blast+
qed
declare sup_state_opt_any_Some [iff]
declare not_Err_eq [iff]
lemma Load_correct:
"⟦ wf_prog wt P;
P ⊢ C sees M,b:Ts→T=(mxs,mxl⇩0,ins,xt) in C;
ins!pc = Load idx;
P,T,mxs,size ins,xt ⊢ ins!pc,pc :: Φ C M;
Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh);
P,Φ ⊢ (None, h, (stk,loc,C,M,pc,ics)#frs, sh)√ ⟧
⟹ P,Φ ⊢ σ'√"
apply(subgoal_tac "ics = No_ics")
prefer 2 apply(cases ics, (auto)[4])
apply clarsimp
apply (drule (1) sees_method_fun)
apply(fastforce elim!: confTs_confT_sup conf_clinit_diff)
done
declare [[simproc del: list_to_set_comprehension]]
lemma Store_correct:
"⟦ wf_prog wt P;
P ⊢ C sees M,b:Ts→T=(mxs,mxl⇩0,ins,xt) in C;
ins!pc = Store idx;
P,T,mxs,size ins,xt ⊢ ins!pc,pc :: Φ C M;
Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh);
P,Φ ⊢ (None, h, (stk,loc,C,M,pc,ics)#frs, sh)√ ⟧
⟹ P,Φ ⊢ σ'√"
apply(subgoal_tac "ics = No_ics")
prefer 2 apply(cases ics, (auto)[4])
apply clarsimp
apply (drule (1) sees_method_fun)
apply (blast intro!: list_all2_update_cong conf_clinit_diff)+
done
lemma Push_correct:
"⟦ wf_prog wt P;
P ⊢ C sees M,b:Ts→T=(mxs,mxl⇩0,ins,xt) in C;
ins!pc = Push v;
P,T,mxs,size ins,xt ⊢ ins!pc,pc :: Φ C M;
Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh);
P,Φ ⊢ (None, h, (stk,loc,C,M,pc,ics)#frs, sh)√ ⟧
⟹ P,Φ ⊢ σ'√"
apply(subgoal_tac "ics = No_ics")
prefer 2 apply(cases ics, (auto)[4])
apply clarsimp
apply (drule (1) sees_method_fun)
apply (blast dest: typeof_lit_conf conf_clinit_diff)+
done
lemma Cast_conf2:
"⟦ wf_prog ok P; P,h ⊢ v :≤ T; is_refT T; cast_ok P C h v;
P ⊢ Class C ≤ T'; is_class P C⟧
⟹ P,h ⊢ v :≤ T'"
apply (unfold cast_ok_def is_refT_def)
apply (frule Class_widen)
apply (elim exE disjE)
apply simp
apply simp
apply simp
apply (clarsimp simp: conf_def obj_ty_def)
apply (cases v)
apply (auto intro: rtrancl_trans)
done
lemma Checkcast_correct:
"⟦ wf_jvm_prog⇘Φ⇙ P;
P ⊢ C sees M,b:Ts→T=(mxs,mxl⇩0,ins,xt) in C;
ins!pc = Checkcast D;
P,T,mxs,size ins,xt ⊢ ins!pc,pc :: Φ C M;
Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh) ;
P,Φ ⊢ (None, h, (stk,loc,C,M,pc,ics)#frs, sh)√;
fst (exec_step P h stk loc C M pc ics frs sh) = None ⟧
⟹ P,Φ ⊢ σ'√"
apply(subgoal_tac "ics = No_ics")
prefer 2 apply(cases ics, (auto)[4])
apply (clarsimp simp: wf_jvm_prog_phi_def split: if_split_asm)
apply (drule (1) sees_method_fun)
apply (blast intro: Cast_conf2 dest: sees_method_fun conf_clinit_diff)
done
declare split_paired_All [simp del]
lemmas widens_Cons [iff] = list_all2_Cons1 [of "widen P"] for P
lemma Getfield_correct:
fixes σ' :: jvm_state
assumes wf: "wf_prog wt P"
assumes mC: "P ⊢ C sees M,b:Ts→T=(mxs,mxl⇩0,ins,xt) in C"
assumes i: "ins!pc = Getfield F D"
assumes wt: "P,T,mxs,size ins,xt ⊢ ins!pc,pc :: Φ C M"
assumes s': "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
assumes cf: "P,Φ ⊢ (None, h, (stk,loc,C,M,pc,ics)#frs, sh)√"
assumes xc: "fst (exec_step P h stk loc C M pc ics frs sh) = None"
shows "P,Φ ⊢ σ'√"
proof -
from mC cf i have [simp]: "ics = No_ics" by(cases ics, auto)
from mC cf obtain ST LT where
"h√": "P ⊢ h √" and
"sh√": "P,h ⊢⇩s sh √" and
Φ: "Φ C M ! pc = Some (ST,LT)" and
stk: "P,h ⊢ stk [:≤] ST" and loc: "P,h ⊢ loc [:≤⇩⊤] LT" and
pc: "pc < size ins" and
fs: "conf_fs P h sh Φ C M (size Ts) T frs" and
confc: "conf_clinit P sh ((stk,loc,C,M,pc,ics)#frs)"
by (fastforce dest: sees_method_fun)
from i Φ wt obtain oT ST'' vT ST' LT' vT' where
oT: "P ⊢ oT ≤ Class D" and
ST: "ST = oT # ST''" and
F: "P ⊢ D sees F,NonStatic:vT in D" and
pc': "pc+1 < size ins" and
Φ': "Φ C M ! (pc+1) = Some (vT'#ST', LT')" and
ST': "P ⊢ ST'' [≤] ST'" and LT': "P ⊢ LT [≤⇩⊤] LT'" and
vT': "P ⊢ vT ≤ vT'"
by fastforce
from stk ST obtain ref stk' where
stk': "stk = ref#stk'" and
ref: "P,h ⊢ ref :≤ oT" and
ST'': "P,h ⊢ stk' [:≤] ST''"
by auto
from stk' i mC s' xc have "ref ≠ Null"
by (simp add: split_beta split:if_split_asm)
moreover from ref oT have "P,h ⊢ ref :≤ Class D" ..
ultimately obtain a D' fs where
a: "ref = Addr a" and h: "h a = Some (D', fs)" and D': "P ⊢ D' ≼⇧* D"
by (blast dest: non_npD)
from D' F have has_field: "P ⊢ D' has F,NonStatic:vT in D"
by (blast intro: has_field_mono has_visible_field)
moreover from "h√" h have "P,h ⊢ (D', fs) √" by (rule hconfD)
ultimately obtain v where v: "fs (F, D) = Some v" "P,h ⊢ v :≤ vT"
by (clarsimp simp: oconf_def has_field_def)
(blast dest: has_fields_fun)
from conf_clinit_diff[OF confc]
have confc': "conf_clinit P sh ((v#stk',loc,C,M,pc+1,ics)#frs)" by simp
from a h i mC s' stk' v xc has_field
have "σ' = (None, h, (v#stk',loc,C,M,pc+1,ics)#frs, sh)"
by(simp add: split_beta split: if_split_asm)
moreover
from ST'' ST' have "P,h ⊢ stk' [:≤] ST'" ..
moreover
from v vT' have "P,h ⊢ v :≤ vT'" by blast
moreover
from loc LT' have "P,h ⊢ loc [:≤⇩⊤] LT'" ..
moreover
note "h√" "sh√" mC Φ' pc' v fs confc'
ultimately
show "P,Φ ⊢ σ' √" by fastforce
qed
lemma Getstatic_nInit_correct:
fixes σ' :: jvm_state
assumes wf: "wf_prog wt P"
assumes mC: "P ⊢ C sees M,b:Ts→T=(mxs,mxl⇩0,ins,xt) in C"
assumes i: "ins!pc = Getstatic C' F D"
assumes wt: "P,T,mxs,size ins,xt ⊢ ins!pc,pc :: Φ C M"
assumes s': "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
assumes cf: "P,Φ ⊢ (None, h, (stk,loc,C,M,pc,ics)#frs, sh)√"
assumes xc: "fst (exec_step P h stk loc C M pc ics frs sh) = None"
assumes cs: "ics = Called [] ∨ (ics = No_ics ∧ (∃sfs. sh (fst(field P D F)) = Some(sfs, Done)))"
shows "P,Φ ⊢ σ'√"
proof -
from mC cf obtain ST LT where
"h√": "P ⊢ h √" and
"sh√": "P,h ⊢⇩s sh √" and
Φ: "Φ C M ! pc = Some (ST,LT)" and
stk: "P,h ⊢ stk [:≤] ST" and loc: "P,h ⊢ loc [:≤⇩⊤] LT" and
pc: "pc < size ins" and
fs: "conf_fs P h sh Φ C M (size Ts) T frs" and
confc: "conf_clinit P sh ((stk,loc,C,M,pc,ics)#frs)" and
vics: "P,h,sh ⊢⇩i (C,M,pc,ics)"
by (fastforce dest: sees_method_fun)
from i Φ wt cs obtain vT ST' LT' vT' where
F: "P ⊢ C' sees F,Static:vT in D" and
pc': "pc+1 < size ins" and
Φ': "Φ C M ! (pc+1) = Some (vT'#ST', LT')" and
ST': "P ⊢ ST [≤] ST'" and LT': "P ⊢ LT [≤⇩⊤] LT'" and
vT': "P ⊢ vT ≤ vT'"
by fastforce
with mC i vics obtain sobj where
cc': "ics = Called [] ⟹ Called_context P D (ins!pc) ∧ sh D = Some sobj"
by(fastforce dest: has_visible_field)
from field_def2[OF sees_field_idemp[OF F]] have D[simp]: "fst(field P D F) = D" by simp
from cs cc' obtain sfs i where shD: "sh D = Some(sfs,i)" by(cases sobj, auto)
note has_field_idemp[OF has_visible_field[OF F]]
moreover from "sh√" shD have "P,h,D ⊢⇩s sfs √" by (rule shconfD)
ultimately obtain v where v: "sfs F = Some v" "P,h ⊢ v :≤ vT"
by (clarsimp simp: soconf_def has_field_def) blast
from i mC s' v xc F cs cc' shD
have "σ' = (None, h, (v#stk,loc,C,M,pc+1,No_ics)#frs, sh)"
by(fastforce simp: split_beta split: if_split_asm init_call_status.splits)
moreover
from stk ST' have "P,h ⊢ stk [:≤] ST'" ..
moreover
from v vT' have "P,h ⊢ v :≤ vT'" by blast
moreover
from loc LT' have "P,h ⊢ loc [:≤⇩⊤] LT'" ..
moreover
have "conf_clinit P sh ((v#stk,loc,C,M,pc+1,No_ics)#frs)" by(rule conf_clinit_diff'[OF confc])
moreover
note "h√" "sh√" mC Φ' pc' v fs
ultimately
show "P,Φ ⊢ σ' √" by fastforce
qed
lemma Getstatic_Init_correct:
fixes σ' :: jvm_state
assumes wf: "wf_prog wt P"
assumes mC: "P ⊢ C sees M,b:Ts→T=(mxs,mxl⇩0,ins,xt) in C"
assumes i: "ins!pc = Getstatic C' F D"
assumes wt: "P,T,mxs,size ins,xt ⊢ ins!pc,pc :: Φ C M"
assumes s': "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,No_ics)#frs, sh)"
assumes cf: "P,Φ ⊢ (None, h, (stk,loc,C,M,pc,No_ics)#frs, sh)√"
assumes xc: "fst (exec_step P h stk loc C M pc No_ics frs sh) = None"
assumes nDone: "∀sfs. sh (fst(field P D F)) ≠ Some(sfs, Done)"
shows "P,Φ ⊢ σ'√"
proof -
from mC cf obtain ST LT where
"h√": "P ⊢ h √" and
"sh√": "P,h ⊢⇩s sh √" and
Φ: "Φ C M ! pc = Some (ST,LT)" and
stk: "P,h ⊢ stk [:≤] ST" and loc: "P,h ⊢ loc [:≤⇩⊤] LT" and
pc: "pc < size ins" and
fs: "conf_fs P h sh Φ C M (size Ts) T frs" and
confc: "conf_clinit P sh ((stk,loc,C,M,pc,No_ics)#frs)"
by (fastforce dest: sees_method_fun)
from i Φ wt nDone obtain vT where
F: "P ⊢ C' sees F,Static:vT in D"
by fastforce
then have has_field: "P ⊢ C' has F,Static:vT in D" by(rule has_visible_field)
from field_def2[OF sees_field_idemp[OF F]] has_field_is_class'[OF has_field] obtain
D[simp]: "fst(field P D F) = D" and
cls: "is_class P D" by simp
from i mC s' xc F nDone
have "σ' = (None, h, (stk,loc,C,M,pc,Calling D [])#frs, sh)"
by(auto simp: split_beta split: if_split_asm init_state.splits)
moreover
from confc have "conf_clinit P sh ((stk,loc,C,M,pc,Calling D [])#frs)"
by(auto simp: conf_clinit_def distinct_clinit_def split: if_split_asm)
moreover
note loc stk "h√" "sh√" mC Φ pc fs i has_field cls
ultimately
show "P,Φ ⊢ σ' √" by fastforce
qed
lemma Putfield_correct:
fixes σ' :: jvm_state
assumes wf: "wf_prog wt P"
assumes mC: "P ⊢ C sees M,b:Ts→T=(mxs,mxl⇩0,ins,xt) in C"
assumes i: "ins!pc = Putfield F D"
assumes wt: "P,T,mxs,size ins,xt ⊢ ins!pc,pc :: Φ C M"
assumes s': "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
assumes cf: "P,Φ ⊢ (None, h, (stk,loc,C,M,pc,ics)#frs, sh)√"
assumes xc: "fst (exec_step P h stk loc C M pc ics frs sh) = None"
shows "P,Φ ⊢ σ'√"
proof -
from mC cf i have [simp]: "ics = No_ics" by(cases ics, auto)
from mC cf obtain ST LT where
"h√": "P ⊢ h √" and
"sh√": "P,h ⊢⇩s sh √" and
Φ: "Φ C M ! pc = Some (ST,LT)" and
stk: "P,h ⊢ stk [:≤] ST" and loc: "P,h ⊢ loc [:≤⇩⊤] LT" and
pc: "pc < size ins" and
fs: "conf_fs P h sh Φ C M (size Ts) T frs" and
confc: "conf_clinit P sh ((stk,loc,C,M,pc,ics) # frs)"
by (fastforce dest: sees_method_fun)
from i Φ wt obtain vT vT' oT ST'' ST' LT' where
ST: "ST = vT # oT # ST''" and
field: "P ⊢ D sees F,NonStatic:vT' in D" and
oT: "P ⊢ oT ≤ Class D" and vT: "P ⊢ vT ≤ vT'" and
pc': "pc+1 < size ins" and
Φ': "Φ C M!(pc+1) = Some (ST',LT')" and
ST': "P ⊢ ST'' [≤] ST'" and LT': "P ⊢ LT [≤⇩⊤] LT'"
by clarsimp
from stk ST obtain v ref stk' where
stk': "stk = v#ref#stk'" and
v: "P,h ⊢ v :≤ vT" and
ref: "P,h ⊢ ref :≤ oT" and
ST'': "P,h ⊢ stk' [:≤] ST''"
by auto
from stk' i mC s' xc have "ref ≠ Null" by (auto simp: split_beta)
moreover from ref oT have "P,h ⊢ ref :≤ Class D" ..
ultimately obtain a D' fs where
a: "ref = Addr a" and h: "h a = Some (D', fs)" and D': "P ⊢ D' ≼⇧* D"
by (blast dest: non_npD)
from v vT have vT': "P,h ⊢ v :≤ vT'" ..
from field D' have has_field: "P ⊢ D' has F,NonStatic:vT' in D"
by (blast intro: has_field_mono has_visible_field)
let ?h' = "h(a↦(D', fs((F, D)↦v)))" and ?f' = "(stk',loc,C,M,pc+1,ics)"
from h have hext: "h ⊴ ?h'" by (rule hext_upd_obj)
have "sh√'": "P,?h' ⊢⇩s sh √" by(rule shconf_hupd_obj[OF "sh√" h])
from a h i mC s' stk' has_field field
have "σ' = (None, ?h', ?f'#frs, sh)" by(simp split: if_split_asm)
moreover
from "h√" h have "P,h ⊢ (D',fs)√" by (rule hconfD)
with has_field vT' have "P,h ⊢ (D',fs((F, D)↦v))√" ..
with "h√" h have "P ⊢ ?h'√" by (rule hconf_upd_obj)
moreover
from ST'' ST' have "P,h ⊢ stk' [:≤] ST'" ..
from this hext have "P,?h' ⊢ stk' [:≤] ST'" by (rule confs_hext)
moreover
from loc LT' have "P,h ⊢ loc [:≤⇩⊤] LT'" ..
from this hext have "P,?h' ⊢ loc [:≤⇩⊤] LT'" by (rule confTs_hext)
moreover
from fs hext
have "conf_fs P ?h' sh Φ C M (size Ts) T frs" by (rule conf_fs_hext)
moreover
have "conf_clinit P sh (?f' # frs)" by(rule conf_clinit_diff[OF confc])
moreover
note mC Φ' pc' "sh√'"
ultimately
show "P,Φ ⊢ σ' √" by fastforce
qed
lemma Putstatic_nInit_correct:
fixes σ' :: jvm_state
assumes wf: "wf_prog wt P"
assumes mC: "P ⊢ C sees M,b:Ts→T=(mxs,mxl⇩0,ins,xt) in C"
assumes i: "ins!pc = Putstatic C' F D"
assumes wt: "P,T,mxs,size ins,xt ⊢ ins!pc,pc :: Φ C M"
assumes s': "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
assumes cf: "P,Φ ⊢ (None, h, (stk,loc,C,M,pc,ics)#frs, sh)√"
assumes xc: "fst (exec_step P h stk loc C M pc ics frs sh) = None"
assumes cs: "ics = Called [] ∨ (ics = No_ics ∧ (∃sfs. sh (fst(field P D F)) = Some(sfs, Done)))"
shows "P,Φ ⊢ σ'√"
proof -
from mC cf obtain ST LT where
"h√": "P ⊢ h √" and
"sh√": "P,h ⊢⇩s sh √" and
Φ: "Φ C M ! pc = Some (ST,LT)" and
stk: "P,h ⊢ stk [:≤] ST" and loc: "P,h ⊢ loc [:≤⇩⊤] LT" and
pc: "pc < size ins" and
fs: "conf_fs P h sh Φ C M (size Ts) T frs" and
confc: "conf_clinit P sh ((stk,loc,C,M,pc,ics)#frs)" and
vics: "P,h,sh ⊢⇩i (C,M,pc,ics)"
by (fastforce dest: sees_method_fun)
from i Φ wt cs obtain vT vT' ST'' ST' LT' where
ST: "ST = vT # ST''" and
F: "P ⊢ C' sees F,Static:vT' in D" and
vT: "P ⊢ vT ≤ vT'" and
pc': "pc+1 < size ins" and
Φ': "Φ C M ! (pc+1) = Some (ST', LT')" and
ST': "P ⊢ ST'' [≤] ST'" and LT': "P ⊢ LT [≤⇩⊤] LT'"
by fastforce
from stk ST obtain v stk' where
stk': "stk = v#stk'" and
v: "P,h ⊢ v :≤ vT" and
ST'': "P,h ⊢ stk' [:≤] ST''"
by auto
from v vT have vT': "P,h ⊢ v :≤ vT'" ..
with mC i vics obtain sobj where
cc': "ics = Called [] ⟹ Called_context P D (ins!pc) ∧ sh D = Some sobj"
by(fastforce dest: has_visible_field)
from field_def2[OF sees_field_idemp[OF F]] have D[simp]: "fst(field P D F) = D" by simp
from cs cc' obtain sfs i where shD: "sh D = Some(sfs,i)" by(cases sobj, auto)
let ?sh' = "sh(D↦(sfs(F↦v),i))" and ?f' = "(stk',loc,C,M,pc+1,No_ics)"
have m_D: "P ⊢ D has F,Static:vT' in D" by (rule has_field_idemp[OF has_visible_field[OF F]])
from "sh√" shD have sfs: "P,h,D ⊢⇩s sfs √" by (rule shconfD)
have "sh'√": "P,h ⊢⇩s ?sh' √" by (rule shconf_upd_obj[OF "sh√" soconf_fupd[OF m_D vT' sfs]])
from i mC s' v xc F cs cc' shD stk'
have "σ' = (None, h, (stk',loc,C,M,pc+1,No_ics)#frs, ?sh')"
by(fastforce simp: split_beta split: if_split_asm init_call_status.splits)
moreover
from ST'' ST' have "P,h ⊢ stk' [:≤] ST'" ..
moreover
from loc LT' have "P,h ⊢ loc [:≤⇩⊤] LT'" ..
moreover
have "conf_fs P h ?sh' Φ C M (size Ts) T frs" by (rule conf_fs_shupd'[OF fs shD])
moreover
have "conf_clinit P ?sh' ((stk',loc,C,M,pc+1,No_ics)#frs)"
by(rule conf_clinit_diff'[OF conf_clinit_shupd'[OF confc shD]])
moreover
note "h√" "sh'√" mC Φ' pc' v vT'
ultimately
show "P,Φ ⊢ σ' √" by fastforce
qed
lemma Putstatic_Init_correct:
fixes σ' :: jvm_state
assumes wf: "wf_prog wt P"
assumes mC: "P ⊢ C sees M,b:Ts→T=(mxs,mxl⇩0,ins,xt) in C"
assumes i: "ins!pc = Putstatic C' F D"
assumes wt: "P,T,mxs,size ins,xt ⊢ ins!pc,pc :: Φ C M"
assumes s': "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,No_ics)#frs, sh)"
assumes cf: "P,Φ ⊢ (None, h, (stk,loc,C,M,pc,No_ics)#frs, sh)√"
assumes xc: "fst (exec_step P h stk loc C M pc No_ics frs sh) = None"
assumes nDone: "∀sfs. sh (fst(field P D F)) ≠ Some(sfs, Done)"
shows "P,Φ ⊢ σ'√"
proof -
from mC cf obtain ST LT where
"h√": "P ⊢ h √" and
"sh√": "P,h ⊢⇩s sh √" and
Φ: "Φ C M ! pc = Some (ST,LT)" and
stk: "P,h ⊢ stk [:≤] ST" and loc: "P,h ⊢ loc [:≤⇩⊤] LT" and
pc: "pc < size ins" and
fs: "conf_fs P h sh Φ C M (size Ts) T frs" and
confc: "conf_clinit P sh ((stk,loc,C,M,pc,No_ics)#frs)"
by (fastforce dest: sees_method_fun)
from i Φ wt nDone obtain vT where
F: "P ⊢ C' sees F,Static:vT in D"
by fastforce
then have has_field: "P ⊢ C' has F,Static:vT in D" by(rule has_visible_field)
from field_def2[OF sees_field_idemp[OF F]] has_field_is_class'[OF has_field] obtain
D[simp]: "fst(field P D F) = D" and
cls: "is_class P D" by simp
from i mC s' xc F nDone
have "σ' = (None, h, (stk,loc,C,M,pc,Calling D [])#frs, sh)"
by(auto simp: split_beta split: if_split_asm init_state.splits)
moreover
from confc have "conf_clinit P sh ((stk,loc,C,M,pc,Calling D [])#frs)"
by(auto simp: conf_clinit_def distinct_clinit_def split: if_split_asm)
moreover
note loc stk "h√" "sh√" mC Φ pc fs i has_field cls
ultimately
show "P,Φ ⊢ σ' √" by fastforce
qed
lemma oconf_blank2 [intro, simp]:
"⟦is_class P C; wf_prog wt P⟧ ⟹ P,h ⊢ blank P C √"
by (fastforce simp: oconf_blank dest: wf_Fields_Ex)
lemma obj_ty_blank [iff]: "obj_ty (blank P C) = Class C"
by (simp add: blank_def)
lemma New_nInit_correct:
fixes σ' :: jvm_state
assumes wf: "wf_prog wt P"
assumes meth: "P ⊢ C sees M,b:Ts→T=(mxs,mxl⇩0,ins,xt) in C"
assumes ins: "ins!pc = New X"
assumes wt: "P,T,mxs,size ins,xt ⊢ ins!pc,pc :: Φ C M"
assumes exec: "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
assumes conf: "P,Φ ⊢ (None, h, (stk,loc,C,M,pc,ics)#frs, sh)√"
assumes no_x: "fst (exec_step P h stk loc C M pc ics frs sh) = None"
assumes cs: "ics = Called [] ∨ (ics = No_ics ∧ (∃sfs. sh X = Some(sfs, Done)))"
shows "P,Φ ⊢ σ'√"
proof -
from ins conf meth
obtain ST LT where
heap_ok: "P⊢ h√" and
sheap_ok: "P,h ⊢⇩s sh √" and
Φ_pc: "Φ C M!pc = Some (ST,LT)" and
frame: "conf_f P h sh (ST,LT) ins (stk,loc,C,M,pc,ics)" and
frames: "conf_fs P h sh Φ C M (size Ts) T frs" and
confc: "conf_clinit P sh ((stk,loc,C,M,pc,ics) # frs)"
by (auto dest: sees_method_fun)
from Φ_pc ins wt
obtain ST' LT' where
is_class_X: "is_class P X" and
mxs: "size ST < mxs" and
suc_pc: "pc+1 < size ins" and
Φ_suc: "Φ C M!(pc+1) = Some (ST', LT')" and
less: "P ⊢ (Class X # ST, LT) ≤⇩i (ST', LT')"
by auto
from ins no_x cs meth obtain oref where new_Addr: "new_Addr h = Some oref" by auto
hence h: "h oref = None" by (rule new_Addr_SomeD)
with exec ins meth new_Addr cs have σ':
"σ' = (None, h(oref ↦ blank P X), (Addr oref#stk,loc,C,M,pc+1,No_ics)#frs, sh)"
(is "σ' = (None, ?h', ?f # frs, sh)")
by auto
moreover
from wf h heap_ok is_class_X have h': "P ⊢ ?h' √"
by (auto intro: hconf_new)
moreover
from h frame less suc_pc wf
have "conf_f P ?h' sh (ST', LT') ins ?f"
apply (clarsimp simp: fun_upd_apply conf_def blank_def split_beta)
apply (auto intro: confs_hext confTs_hext)
done
moreover
from h have "h ⊴ ?h'" by simp
with frames have "conf_fs P ?h' sh Φ C M (size Ts) T frs" by (rule conf_fs_hext)
moreover
have "P,?h' ⊢⇩s sh √" by(rule shconf_hnew[OF sheap_ok h])
moreover
have "conf_clinit P sh (?f # frs)" by(rule conf_clinit_diff'[OF confc])
ultimately
show ?thesis using meth Φ_suc by fastforce
qed
lemma New_Init_correct:
fixes σ' :: jvm_state
assumes wf: "wf_prog wt P"
assumes meth: "P ⊢ C sees M,b:Ts→T=(mxs,mxl⇩0,ins,xt) in C"
assumes ins: "ins!pc = New X"
assumes wt: "P,T,mxs,size ins,xt ⊢ ins!pc,pc :: Φ C M"
assumes exec: "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,No_ics)#frs, sh)"
assumes conf: "P,Φ ⊢ (None, h, (stk,loc,C,M,pc,No_ics)#frs, sh)√"
assumes no_x: "fst (exec_step P h stk loc C M pc No_ics frs sh) = None"
assumes nDone: "∀sfs. sh X ≠ Some(sfs, Done)"
shows "P,Φ ⊢ σ'√"
proof -
from ins conf meth
obtain ST LT where
heap_ok: "P⊢ h√" and
sheap_ok: "P,h ⊢⇩s sh √" and
Φ_pc: "Φ C M!pc = Some (ST,LT)" and
frame: "conf_f P h sh (ST,LT) ins (stk,loc,C,M,pc,No_ics)" and
frames: "conf_fs P h sh Φ C M (size Ts) T frs" and
confc: "conf_clinit P sh ((stk,loc,C,M,pc,No_ics) # frs)"
by (auto dest: sees_method_fun)
from Φ_pc ins wt
obtain ST' LT' where
is_class_X: "is_class P X" and
mxs: "size ST < mxs" and
suc_pc: "pc+1 < size ins" and
Φ_suc: "Φ C M!(pc+1) = Some (ST', LT')" and
less: "P ⊢ (Class X # ST, LT) ≤⇩i (ST', LT')"
by auto
with exec ins meth nDone have σ':
"σ' = (None, h, (stk,loc,C,M,pc,Calling X [])#frs, sh)"
(is "σ' = (None, h, ?f # frs, sh)")
by(auto split: init_state.splits)
moreover
from meth frame is_class_X ins
have "conf_f P h sh (ST, LT) ins ?f" by auto
moreover note heap_ok sheap_ok frames
moreover
from confc have "conf_clinit P sh (?f # frs)"
by(auto simp: conf_clinit_def distinct_clinit_def split: if_split_asm)
ultimately
show ?thesis using meth Φ_pc by fastforce
qed
lemma Goto_correct:
"⟦ wf_prog wt P;
P ⊢ C sees M,b:Ts→T=(mxs,mxl⇩0,ins,xt) in C;
ins ! pc = Goto branch;
P,T,mxs,size ins,xt ⊢ ins!pc,pc :: Φ C M;
Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh) ;
P,Φ ⊢ (None, h, (stk,loc,C,M,pc,ics)#frs, sh)√ ⟧
⟹ P,Φ ⊢ σ'√"
apply(subgoal_tac "ics = No_ics")
prefer 2 apply(cases ics, (auto)[4])
apply clarsimp
apply (drule (1) sees_method_fun)
apply (fastforce elim!: conf_clinit_diff)
done
lemma IfFalse_correct:
"⟦ wf_prog wt P;
P ⊢ C sees M,b:Ts→T=(mxs,mxl⇩0,ins,xt) in C;
ins ! pc = IfFalse branch;
P,T,mxs,size ins,xt ⊢ ins!pc,pc :: Φ C M;
Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh) ;
P,Φ ⊢ (None, h, (stk,loc,C,M,pc,ics)#frs, sh)√ ⟧
⟹ P,Φ ⊢ σ'√"
apply(subgoal_tac "ics = No_ics")
prefer 2 apply(cases ics, (auto)[4])
apply clarsimp
apply (drule (1) sees_method_fun)
apply (fastforce elim!: conf_clinit_diff)
done
lemma CmpEq_correct:
"⟦ wf_prog wt P;
P ⊢ C sees M,b:Ts→T=(mxs,mxl⇩0,ins,xt) in C;
ins ! pc = CmpEq;
P,T,mxs,size ins,xt ⊢ ins!pc,pc :: Φ C M;
Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh) ;
P,Φ ⊢ (None, h, (stk,loc,C,M,pc,ics)#frs, sh)√ ⟧
⟹ P,Φ ⊢ σ'√"
apply(subgoal_tac "ics = No_ics")
prefer 2 apply(cases ics, (auto)[4])
apply clarsimp
apply (drule (1) sees_method_fun)
apply (fastforce elim!: conf_clinit_diff)
done
lemma Pop_correct:
"⟦ wf_prog wt P;
P ⊢ C sees M,b:Ts→T=(mxs,mxl⇩0,ins,xt) in C;
ins ! pc = Pop;
P,T,mxs,size ins,xt ⊢ ins!pc,pc :: Φ C M;
Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh) ;
P,Φ ⊢ (None, h, (stk,loc,C,M,pc,ics)#frs, sh)√ ⟧
⟹ P,Φ ⊢ σ'√"
apply(subgoal_tac "ics = No_ics")
prefer 2 apply(cases ics, (auto)[4])
apply clarsimp
apply (drule (1) sees_method_fun)
apply (fastforce elim!: conf_clinit_diff)
done
lemma IAdd_correct:
"⟦ wf_prog wt P;
P ⊢ C sees M,b:Ts→T=(mxs,mxl⇩0,ins,xt) in C;
ins ! pc = IAdd;
P,T,mxs,size ins,xt ⊢ ins!pc,pc :: Φ C M;
Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh) ;
P,Φ ⊢ (None, h, (stk,loc,C,M,pc,ics)#frs, sh)√ ⟧
⟹ P,Φ ⊢ σ'√"
apply(subgoal_tac "ics = No_ics")
prefer 2 apply(cases ics, (auto)[4])
apply (clarsimp simp: conf_def)
apply (drule (1) sees_method_fun)
apply (fastforce elim!: conf_clinit_diff)
done
lemma Throw_correct:
"⟦ wf_prog wt P;
P ⊢ C sees M,b:Ts→T=(mxs,mxl⇩0,ins,xt) in C;
ins ! pc = Throw;
Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh) ;
P,Φ ⊢ (None, h, (stk,loc,C,M,pc,ics)#frs, sh)√;
fst (exec_step P h stk loc C M pc ics frs sh) = None ⟧
⟹ P,Φ ⊢ σ'√"
apply(subgoal_tac "ics = No_ics")
prefer 2 apply(cases ics, (auto)[4])
apply simp
done
text ‹
The next theorem collects the results of the sections above,
i.e.~exception handling, initialization procedure steps, and
the execution step for each instruction. It states type safety
for single step execution: in welltyped programs, a conforming
state is transformed into another conforming state when one
step of execution is performed.
›
lemma step_correct:
fixes σ' :: jvm_state
assumes wtp: "wf_jvm_prog⇘Φ⇙ P"
and meth: "P ⊢ C sees M,b:Ts→T=(mxs,mxl⇩0,ins,xt) in C"
and exec: "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,ics)#frs, sh)"
and conf: "P,Φ ⊢ (None, h, (stk,loc,C,M,pc,ics)#frs, sh)√"
shows "P,Φ ⊢ σ'√"
proof -
from assms have pc: "pc < length ins" by(auto dest: sees_method_fun)
with wt_jvm_prog_impl_wt_instr[OF wtp meth] have wt: "P,T,mxs,size ins,xt ⊢ ins!pc,pc :: Φ C M"
by simp
from conf obtain ST LT where Φ: "Φ C M ! pc = Some(ST,LT)" by clarsimp
show ?thesis
proof(cases "fst (exec_step P h stk loc C M pc ics frs sh)")
case Some show ?thesis by(rule xcpt_correct[OF wtp meth wt Some exec conf])
next
case None
from wt_jvm_progD[OF wtp] obtain wf_md where wf: "wf_prog wf_md P" by clarify
{ assume [simp]: "ics = No_ics"
from exec conf None obtain
exec': "Some σ' = exec (P, None, h, (stk,loc,C,M,pc,No_ics)#frs, sh)"
and conf': "P,Φ ⊢ (None, h, (stk,loc,C,M,pc,No_ics)#frs, sh)√"
and None': "fst (exec_step P h stk loc C M pc No_ics frs sh) = None" by simp
have ?thesis
proof(cases "ins!pc")
case Load from Load_correct[OF wf meth this wt exec conf] show ?thesis by simp
next
case Store from Store_correct[OF wf meth this wt exec conf] show ?thesis by simp
next
case Push from Push_correct[OF wf meth this wt exec conf] show ?thesis by simp
next
case (New C) show ?thesis
proof(cases "∃sfs. sh C = Some(sfs, Done)")
case True
with New_nInit_correct[OF wf meth New wt exec conf None] show ?thesis by simp
next
case False
with New_Init_correct[OF wf meth New wt exec' conf' None'] show ?thesis by simp
qed
next
case Getfield from Getfield_correct[OF wf meth this wt exec conf None]
show ?thesis by simp
next
case (Getstatic C F D) show ?thesis
proof(cases "∃sfs. sh (fst (field P D F)) = Some(sfs, Done)")
case True
with Getstatic_nInit_correct[OF wf meth Getstatic wt exec conf None] show ?thesis by simp
next
case False
with Getstatic_Init_correct[OF wf meth Getstatic wt exec' conf' None']
show ?thesis by simp
qed
next
case Putfield from Putfield_correct[OF wf meth this wt exec conf None]
show ?thesis by simp
next
case (Putstatic C F D) show ?thesis
proof(cases "∃sfs. sh (fst (field P D F)) = Some(sfs, Done)")
case True
with Putstatic_nInit_correct[OF wf meth Putstatic wt exec conf None] show ?thesis by simp
next
case False
with Putstatic_Init_correct[OF wf meth Putstatic wt exec' conf' None']
show ?thesis by simp
qed
next
case Checkcast from Checkcast_correct[OF wtp meth this wt exec conf None]
show ?thesis by simp
next
case Invoke with Invoke_correct[OF wtp meth this wt exec conf None] show ?thesis by simp
next
case (Invokestatic C M n)
from wf_jvm_prog_nclinit[OF wtp meth wt pc Φ this] have ncl: "M ≠ clinit" by simp
show ?thesis
proof(cases "∃sfs. sh (fst (method P C M)) = Some(sfs, Done)")
case True
with Invokestatic_nInit_correct[OF wtp meth Invokestatic ncl wt exec conf None]
show ?thesis by simp
next
case False
with Invokestatic_Init_correct[OF wtp meth Invokestatic ncl wt exec' conf' None']
show ?thesis by simp
qed
next
case Return with Return_correct[OF wtp meth this wt exec conf] show ?thesis by simp
next
case Pop with Pop_correct[OF wf meth this wt exec conf] show ?thesis by simp
next
case IAdd with IAdd_correct[OF wf meth this wt exec conf] show ?thesis by simp
next
case Goto with Goto_correct[OF wf meth this wt exec conf] show ?thesis by simp
next
case CmpEq with CmpEq_correct[OF wf meth this wt exec conf] show ?thesis by simp
next
case IfFalse with IfFalse_correct[OF wf meth this wt exec conf] show ?thesis by simp
next
case Throw with Throw_correct[OF wf meth this exec conf None] show ?thesis by simp
qed
}
moreover
{ fix Cs assume [simp]: "ics = Called Cs"
have ?thesis
proof(cases Cs)
case [simp]: Nil
from conf meth obtain C1 where "Called_context P C1 (ins ! pc)"
by(clarsimp simp: conf_f_def2 intro!: Called_context_Called_set)
then have "ins!pc ∈ Called_set" by(rule Called_context_Called_set)
then show ?thesis
proof(cases "ins!pc")
case (New C)
from New_nInit_correct[OF wf meth this wt exec conf None] show ?thesis by simp
next
case (Getstatic C F D)
from Getstatic_nInit_correct[OF wf meth this wt exec conf None] show ?thesis by simp
next
case (Putstatic C F D)
from Putstatic_nInit_correct[OF wf meth this wt exec conf None] show ?thesis by simp
next
case (Invokestatic C M n)
from wf_jvm_prog_nclinit[OF wtp meth wt pc Φ this] have ncl: "M ≠ clinit" by simp
with Invokestatic_nInit_correct[OF wtp meth Invokestatic ncl wt exec conf None]
show ?thesis by simp
qed(simp_all)
next
case (Cons C' Cs') with Called_correct[OF wtp meth exec conf None] show ?thesis by simp
qed
}
moreover
{ fix C' Cs assume [simp]: "ics = Calling C' Cs"
with Calling_correct[OF wtp meth exec conf None] have ?thesis by simp
}
moreover
{ fix Cs a assume [simp]: "ics = Throwing Cs a"
have ?thesis
proof(cases Cs)
case Nil with exec None show ?thesis by simp
next
case (Cons C' Cs')
with Throwing_correct[OF wtp meth exec conf None] show ?thesis by simp
qed
}
ultimately show ?thesis by(cases ics) auto
qed
qed
subsection ‹ Main ›
lemma correct_state_impl_Some_method:
"P,Φ ⊢ (None, h, (stk,loc,C,M,pc,ics)#frs, sh)√
⟹ ∃b m Ts T. P ⊢ C sees M,b:Ts→T = m in C"
by fastforce
lemma BV_correct_1 [rule_format]:
"⋀σ. ⟦ wf_jvm_prog⇘Φ⇙ P; P,Φ ⊢ σ√⟧ ⟹ P ⊢ σ -jvm→⇩1 σ' ⟶ P,Φ ⊢ σ'√"
apply (simp only: split_tupled_all exec_1_iff)
apply (rename_tac xp h frs sh)
apply (case_tac xp)
apply (case_tac frs)
apply simp
apply (simp only: split_tupled_all)
apply hypsubst
apply (frule correct_state_impl_Some_method)
apply clarify
apply (rule step_correct)
apply assumption+
apply (rule sym)
apply assumption+
apply (case_tac frs)
apply simp_all
done
theorem progress:
"⟦ xp=None; frs≠[] ⟧ ⟹ ∃σ'. P ⊢ (xp,h,frs,sh) -jvm→⇩1 σ'"
by (clarsimp simp: exec_1_iff neq_Nil_conv split_beta
simp del: split_paired_Ex)
lemma progress_conform:
"⟦wf_jvm_prog⇘Φ⇙ P; P,Φ ⊢ (xp,h,frs,sh)√; xp=None; frs≠[]⟧
⟹ ∃σ'. P ⊢ (xp,h,frs,sh) -jvm→⇩1 σ' ∧ P,Φ ⊢ σ'√"
apply (drule progress)
apply assumption
apply (fast intro: BV_correct_1)
done
theorem BV_correct [rule_format]:
"⟦ wf_jvm_prog⇘Φ⇙ P; P ⊢ σ -jvm→ σ' ⟧ ⟹ P,Φ ⊢ σ√ ⟶ P,Φ ⊢ σ'√"
apply (simp only: exec_all_def1)
apply (erule rtrancl_induct)
apply simp
apply clarify
apply (erule (2) BV_correct_1)
done
lemma hconf_start:
assumes wf: "wf_prog wf_mb P"
shows "P ⊢ (start_heap P) √"
apply (unfold hconf_def)
apply (simp add: preallocated_start)
apply (clarify)
apply (drule sym)
apply (unfold start_heap_def)
apply (insert wf)
apply (auto simp: fun_upd_apply is_class_xcpt split: if_split_asm)
done
lemma shconf_start:
"¬ is_class P Start ⟹ P,start_heap P ⊢⇩s start_sheap √"
apply (unfold shconf_def)
apply (clarsimp simp: preallocated_start fun_upd_apply soconf_def has_field_is_class)
done
lemma BV_correct_initial:
shows "⟦ wf_jvm_prog⇘Φ⇙ P; ¬is_class P Start;
P ⊢ C sees M,Static:[]→Void = m in C; M ≠ clinit;
Φ' Start start_m = start_φ⇩m ⟧
⟹ start_prog P C M,Φ' ⊢ start_state P √"
apply(subgoal_tac "is_class P Object")
prefer 2 apply(simp add: wf_jvm_prog_phi_def)
apply(subgoal_tac "∃Mm. P ⊢ Object sees_methods Mm")
prefer 2 apply(fastforce simp: is_class_def dest: sees_methods_Object)
apply (cases m)
apply (unfold start_state_def)
apply (unfold correct_state_def)
apply (simp del: defs1)
apply (rule conjI)
apply (simp add: wf_jvm_prog_phi_def class_add_hconf_wf[OF _ hconf_start] start_heap_nStart)
apply (rule conjI)
using start_prog_start_shconf apply(simp add: wf_jvm_prog_phi_def)
apply (rule conjI)
apply(simp add: conf_clinit_def distinct_clinit_def)
apply (drule wt_jvm_prog_impl_wt_start, assumption+)
apply (unfold conf_f_def wt_start_def)
apply (fastforce dest: start_prog_Start_sees_start_method)
done
declare [[simproc add: list_to_set_comprehension]]
theorem typesafe:
assumes welltyped: "wf_jvm_prog⇘Φ⇙ P"
assumes nstart: "¬ is_class P Start"
assumes main_method: "P ⊢ C sees M,Static:[]→Void = m in C"
assumes nclinit: "M ≠ clinit"
assumes Φ: "⋀C. C ≠ Start ⟹ Φ' C = Φ C"
assumes Φ': "Φ' Start start_m = start_φ⇩m" "Φ' Start clinit = start_φ⇩m"
assumes Obj_start_m:
"(⋀b' Ts' T' m' D'. P ⊢ Object sees start_m, b' : Ts'→T' = m' in D'
⟹ b' = Static ∧ Ts' = [] ∧ T' = Void)"
shows "start_prog P C M ⊢ start_state P -jvm→ σ ⟹ start_prog P C M,Φ' ⊢ σ √"
proof -
from welltyped nstart main_method nclinit Φ'(1)
have "start_prog P C M,Φ' ⊢ start_state P √" by (rule BV_correct_initial)
moreover
assume "start_prog P C M ⊢ start_state P -jvm→ σ"
moreover
from start_prog_wf_jvm_prog_phi[OF welltyped nstart main_method nclinit Φ Φ' Obj_start_m]
have "wf_jvm_prog⇘Φ'⇙(start_prog P C M)" by simp
ultimately
show "start_prog P C M,Φ' ⊢ σ √" using welltyped by - (rule BV_correct)
qed
end
Theory BVNoTypeError
section ‹ Welltyped Programs produce no Type Errors ›
theory BVNoTypeError
imports "../JVM/JVMDefensive" BVSpecTypeSafe
begin
lemma has_methodI:
"P ⊢ C sees M,b:Ts→T = m in D ⟹ P ⊢ C has M,b"
by (unfold has_method_def) blast
text ‹
Some simple lemmas about the type testing functions of the
defensive JVM:
›
lemma typeof_NoneD [simp,dest]: "typeof v = Some x ⟹ ¬is_Addr v"
by (cases v) auto
lemma is_Ref_def2:
"is_Ref v = (v = Null ∨ (∃a. v = Addr a))"
by (cases v) (auto simp add: is_Ref_def)
lemma [iff]: "is_Ref Null" by (simp add: is_Ref_def2)
lemma is_RefI [intro, simp]: "P,h ⊢ v :≤ T ⟹ is_refT T ⟹ is_Ref v"
apply (cases T)
apply (auto simp add: is_refT_def is_Ref_def dest: conf_ClassD)
done
lemma is_IntgI [intro, simp]: "P,h ⊢ v :≤ Integer ⟹ is_Intg v"
apply (unfold conf_def)
apply auto
done
lemma is_BoolI [intro, simp]: "P,h ⊢ v :≤ Boolean ⟹ is_Bool v"
apply (unfold conf_def)
apply auto
done
declare defs1 [simp del]
lemma wt_jvm_prog_states_NonStatic:
"⟦ wf_jvm_prog⇘Φ⇙ P; P ⊢ C sees M,NonStatic: Ts→T = (mxs, mxl, ins, et) in C;
Φ C M ! pc = τ; pc < size ins ⟧
⟹ OK τ ∈ states P mxs (1+size Ts+mxl)"
apply (unfold wf_jvm_prog_phi_def)
apply (drule (1) sees_wf_mdecl)
apply (simp add: wf_mdecl_def wt_method_def check_types_def)
apply (blast intro: nth_in)
done
lemma wt_jvm_prog_states_Static:
"⟦ wf_jvm_prog⇘Φ⇙ P; P ⊢ C sees M,Static: Ts→T = (mxs, mxl, ins, et) in C;
Φ C M ! pc = τ; pc < size ins ⟧
⟹ OK τ ∈ states P mxs (size Ts+mxl)"
apply (unfold wf_jvm_prog_phi_def)
apply (drule (1) sees_wf_mdecl)
apply (simp add: wf_mdecl_def wt_method_def check_types_def)
apply (blast intro: nth_in)
done
text ‹
The main theorem: welltyped programs do not produce type errors if they
are started in a conformant state.
›
theorem no_type_error:
fixes σ :: jvm_state
assumes welltyped: "wf_jvm_prog⇘Φ⇙ P" and conforms: "P,Φ ⊢ σ √"
shows "exec_d P σ ≠ TypeError"
proof -
from welltyped obtain mb where wf: "wf_prog mb P" by (fast dest: wt_jvm_progD)
obtain xcp h frs sh where s [simp]: "σ = (xcp, h, frs, sh)" by (cases σ)
from conforms have "xcp ≠ None ∨ frs = [] ⟹ check P σ"
by (unfold correct_state_def check_def) auto
moreover {
assume "¬(xcp ≠ None ∨ frs = [])"
then obtain stk reg C M pc ics frs' where
xcp [simp]: "xcp = None" and
frs [simp]: "frs = (stk,reg,C,M,pc,ics)#frs'"
by (clarsimp simp add: neq_Nil_conv)
from conforms obtain ST LT b Ts T mxs mxl ins xt where
hconf: "P ⊢ h √" and
shconf: "P,h ⊢⇩s sh √" and
meth: "P ⊢ C sees M,b:Ts→T = (mxs, mxl, ins, xt) in C" and
Φ: "Φ C M ! pc = Some (ST,LT)" and
frame: "conf_f P h sh (ST,LT) ins (stk,reg,C,M,pc,ics)" and
frames: "conf_fs P h sh Φ C M (size Ts) T frs'"
by (fastforce simp add: correct_state_def dest: sees_method_fun)
from frame obtain
stk: "P,h ⊢ stk [:≤] ST" and
reg: "P,h ⊢ reg [:≤⇩⊤] LT" and
pc: "pc < size ins"
by (simp add: conf_f_def)
from welltyped meth Φ pc
have "OK (Some (ST, LT)) ∈ states P mxs (1+size Ts+mxl)
∨ OK (Some (ST, LT)) ∈ states P mxs (size Ts+mxl)"
by (cases b, auto dest: wt_jvm_prog_states_NonStatic wt_jvm_prog_states_Static)
hence "size ST ≤ mxs" by (auto simp add: JVM_states_unfold)
with stk have mxs: "size stk ≤ mxs"
by (auto dest: list_all2_lengthD)
from welltyped meth pc
have "P,T,mxs,size ins,xt ⊢ ins!pc,pc :: Φ C M"
by (rule wt_jvm_prog_impl_wt_instr)
hence app⇩0: "app (ins!pc) P mxs T pc (size ins) xt (Φ C M!pc) "
by (simp add: wt_instr_def)
with Φ have eff:
"∀(pc',s')∈set (eff (ins ! pc) P pc xt (Φ C M ! pc)). pc' < size ins"
by (unfold app_def) simp
from app⇩0 Φ have app:
"xcpt_app (ins!pc) P pc mxs xt (ST,LT) ∧ app⇩i (ins!pc, P, pc, mxs, T, (ST,LT))"
by (clarsimp simp add: app_def)
with eff stk reg
have "check_instr (ins!pc) P h stk reg C M pc frs' sh"
proof (cases "ins!pc")
case (Getfield F C)
with app stk reg Φ obtain v vT stk' where
field: "P ⊢ C sees F,NonStatic:vT in C" and
stk: "stk = v # stk'" and
conf: "P,h ⊢ v :≤ Class C"
by auto
from conf have is_Ref: "is_Ref v" by auto
moreover {
assume "v ≠ Null"
with conf field is_Ref wf
have "∃D vs. h (the_Addr v) = Some (D,vs) ∧ P ⊢ D ≼⇧* C"
by (auto dest!: non_npD)
}
ultimately show ?thesis using Getfield field stk hconf
apply clarsimp
apply (rule conjI, fastforce)
apply clarsimp
apply (drule has_visible_field)
apply (drule (1) has_field_mono)
apply (drule (1) hconfD)
apply (unfold oconf_def has_field_def)
apply clarsimp
apply (fastforce dest: has_fields_fun)
done
next
case (Getstatic C F D)
with app stk reg Φ obtain vT where
field: "P ⊢ C sees F,Static:vT in D"
by auto
then show ?thesis using Getstatic field stk shconf
apply clarsimp
apply (rule conjI, fastforce)
apply clarsimp
apply (drule has_visible_field)
apply (drule has_field_idemp)
apply (drule (1) shconfD)
apply (unfold soconf_def has_field_def)
apply clarsimp
apply (fastforce dest: has_fields_fun)
done
next
case (Putfield F C)
with app stk reg Φ obtain v ref vT stk' where
field: "P ⊢ C sees F,NonStatic:vT in C" and
stk: "stk = v # ref # stk'" and
confv: "P,h ⊢ v :≤ vT" and
confr: "P,h ⊢ ref :≤ Class C"
by fastforce
from confr have is_Ref: "is_Ref ref" by simp
moreover {
assume "ref ≠ Null"
with confr field is_Ref wf
have "∃D vs. h (the_Addr ref) = Some (D,vs) ∧ P ⊢ D ≼⇧* C"
by (auto dest: non_npD)
}
ultimately show ?thesis using Putfield field stk confv by fastforce
next
case (Invoke M' n)
with app have n: "n < size ST" by simp
from stk have [simp]: "size stk = size ST" by (rule list_all2_lengthD)
{ assume "stk!n = Null" with n Invoke have ?thesis by simp }
moreover {
assume "ST!n = NT"
with n stk have "stk!n = Null" by (auto simp: list_all2_conv_all_nth)
with n Invoke have ?thesis by simp
}
moreover {
assume Null: "stk!n ≠ Null" and NT: "ST!n ≠ NT"
from NT app Invoke
obtain D D' Ts T m where
D: "ST!n = Class D" and
M': "P ⊢ D sees M',NonStatic: Ts→T = m in D'" and
Ts: "P ⊢ rev (take n ST) [≤] Ts"
by auto
from D stk n have "P,h ⊢ stk!n :≤ Class D"
by (auto simp: list_all2_conv_all_nth)
with Null obtain a C' fs where
[simp]: "stk!n = Addr a" "h a = Some (C',fs)" and
"P ⊢ C' ≼⇧* D"
by (fastforce dest!: conf_ClassD)
with M' wf obtain m' Ts' T' D'' where
C': "P ⊢ C' sees M',NonStatic: Ts'→T' = m' in D''" and
Ts': "P ⊢ Ts [≤] Ts'"
by (auto dest!: sees_method_mono)
from stk have "P,h ⊢ take n stk [:≤] take n ST" ..
hence "P,h ⊢ rev (take n stk) [:≤] rev (take n ST)" ..
also note Ts also note Ts'
finally have "P,h ⊢ rev (take n stk) [:≤] Ts'" .
with Invoke Null n C'
have ?thesis by (auto simp add: is_Ref_def2 has_methodI)
}
ultimately show ?thesis by blast
next
case (Invokestatic C M' n)
with app have n: "n ≤ size ST" by simp
from stk have [simp]: "size stk = size ST" by (rule list_all2_lengthD)
from app Invokestatic
obtain D Ts T m where
M': "P ⊢ C sees M',Static: Ts→T = m in D" and
Ts: "P ⊢ rev (take n ST) [≤] Ts"
by auto
from stk have "P,h ⊢ take n stk [:≤] take n ST" ..
hence "P,h ⊢ rev (take n stk) [:≤] rev (take n ST)" ..
also note Ts
finally have "P,h ⊢ rev (take n stk) [:≤] Ts" .
with Invokestatic n M'
show ?thesis by (auto simp add: is_Ref_def2 has_methodI)
next
case Return
show ?thesis
proof(cases "M = clinit")
case True
have "is_class P C" by(rule sees_method_is_class[OF meth])
with wf_sees_clinit[OF wf]
obtain m where "P ⊢ C sees clinit,Static: [] → Void = m in C"
by(fastforce simp: is_class_def)
with stk app Φ meth frames True Return
show ?thesis by (auto simp add: has_methodI)
next
case False with stk app Φ meth frames Return
show ?thesis by (auto intro: has_methodI)
qed
qed (auto simp add: list_all2_lengthD)
hence "check P σ" using meth pc mxs by (auto simp: check_def intro: has_methodI)
} ultimately
have "check P σ" by blast
thus "exec_d P σ ≠ TypeError" ..
qed
text ‹
The theorem above tells us that, in welltyped programs, the
defensive machine reaches the same result as the aggressive
one (after arbitrarily many steps).
›
theorem welltyped_aggressive_imp_defensive:
"wf_jvm_prog⇘Φ⇙ P ⟹ P,Φ ⊢ σ √ ⟹ P ⊢ σ -jvm→ σ'
⟹ P ⊢ (Normal σ) -jvmd→ (Normal σ')"
apply (simp only: exec_all_def)
apply (erule rtrancl_induct)
apply (simp add: exec_all_d_def1)
apply simp
apply (simp only: exec_all_def [symmetric])
apply (frule BV_correct, assumption+)
apply (drule no_type_error, assumption, drule no_type_error_commutes, simp)
apply (simp add: exec_all_d_def1)
apply (rule rtrancl_trans, assumption)
apply (drule exec_1_d_NormalI)
apply auto
done
text ‹
As corollary we get that the aggressive and the defensive machine
are equivalent for welltyped programs (if started in a conformant
state or in the canonical start state)
›
corollary welltyped_commutes:
fixes σ :: jvm_state
assumes wf: "wf_jvm_prog⇘Φ⇙ P" and conforms: "P,Φ ⊢ σ √"
shows "P ⊢ (Normal σ) -jvmd→ (Normal σ') = P ⊢ σ -jvm→ σ'"
apply rule
apply (erule defensive_imp_aggressive)
apply (erule welltyped_aggressive_imp_defensive [OF wf conforms])
done
corollary welltyped_initial_commutes:
assumes wf: "wf_jvm_prog P"
assumes nstart: "¬ is_class P Start"
assumes meth: "P ⊢ C sees M,Static:[]→Void = b in C"
assumes nclinit: "M ≠ clinit"
assumes Obj_start_m:
"(⋀b' Ts' T' m' D'. P ⊢ Object sees start_m, b' : Ts'→T' = m' in D'
⟹ b' = Static ∧ Ts' = [] ∧ T' = Void)"
defines start: "σ ≡ start_state P"
shows "start_prog P C M ⊢ (Normal σ) -jvmd→ (Normal σ') = start_prog P C M ⊢ σ -jvm→ σ'"
proof -
from wf obtain Φ where wf': "wf_jvm_prog⇘Φ⇙ P" by (auto simp: wf_jvm_prog_def)
let ?Φ = "Φ_start Φ"
from start_prog_wf_jvm_prog_phi[where Φ'="?Φ", OF wf' nstart meth nclinit Φ_start Obj_start_m]
have "wf_jvm_prog⇘?Φ⇙(start_prog P C M)" by simp
moreover
from wf' nstart meth nclinit Φ_start(2) have "start_prog P C M,?Φ ⊢ σ √"
unfolding start by (rule BV_correct_initial)
ultimately show ?thesis by (rule welltyped_commutes)
qed
lemma not_TypeError_eq [iff]:
"x ≠ TypeError = (∃t. x = Normal t)"
by (cases x) auto
locale cnf =
fixes P and Φ and σ
assumes wf: "wf_jvm_prog⇘Φ⇙ P"
assumes cnf: "correct_state P Φ σ"
theorem (in cnf) no_type_errors:
"P ⊢ (Normal σ) -jvmd→ σ' ⟹ σ' ≠ TypeError"
apply (unfold exec_all_d_def1)
apply (erule rtrancl_induct)
apply simp
apply (fold exec_all_d_def1)
apply (insert cnf wf)
apply clarsimp
apply (drule defensive_imp_aggressive)
apply (frule (2) BV_correct)
apply (auto simp add: exec_1_d_eq dest: no_type_error)
done
locale start =
fixes P and C and M and σ and T and b and P⇩0
assumes wf: "wf_jvm_prog P"
assumes nstart: "¬ is_class P Start"
assumes sees: "P ⊢ C sees M,Static:[]→Void = b in C"
assumes nclinit: "M ≠ clinit"
assumes Obj_start_m: "(⋀b' Ts' T' m' D'. P ⊢ Object sees start_m, b' : Ts'→T' = m' in D'
⟹ b' = Static ∧ Ts' = [] ∧ T' = Void)"
defines "σ ≡ Normal (start_state P)"
defines [simp]: "P⇩0 ≡ start_prog P C M"
corollary (in start) bv_no_type_error:
shows "P⇩0 ⊢ σ -jvmd→ σ' ⟹ σ' ≠ TypeError"
proof -
from wf obtain Φ where wf': "wf_jvm_prog⇘Φ⇙ P" by (auto simp: wf_jvm_prog_def)
let ?Φ = "Φ_start Φ"
from start_prog_wf_jvm_prog_phi[where Φ'="?Φ", OF wf' nstart sees nclinit Φ_start Obj_start_m]
have "wf_jvm_prog⇘?Φ⇙P⇩0" by simp
moreover
from BV_correct_initial[where Φ'="?Φ", OF wf' nstart sees nclinit Φ_start(2)]
have "correct_state P⇩0 ?Φ (start_state P)" by simp
ultimately have "cnf P⇩0 ?Φ (start_state P)" by (rule cnf.intro)
moreover assume "P⇩0 ⊢ σ -jvmd→ σ'"
ultimately show ?thesis by (unfold σ_def) (rule cnf.no_type_errors)
qed
end
Theory J1
chapter ‹ Compilation \label{cha:comp} ›
section ‹ An Intermediate Language ›
theory J1 imports "../J/BigStep" begin
type_synonym expr⇩1 = "nat exp"
type_synonym J⇩1_prog = "expr⇩1 prog"
type_synonym state⇩1 = "heap × (val list) × sheap"
definition hp⇩1 :: "state⇩1 ⇒ heap"
where
"hp⇩1 ≡ fst"
definition lcl⇩1 :: "state⇩1 ⇒ val list"
where
"lcl⇩1 ≡ fst ∘ snd"
definition shp⇩1 :: "state⇩1 ⇒ sheap"
where
"shp⇩1 ≡ snd ∘ snd"
declare hp⇩1_def[simp] lcl⇩1_def[simp] shp⇩1_def[simp]
primrec
max_vars :: "'a exp ⇒ nat"
and max_varss :: "'a exp list ⇒ nat"
where
"max_vars(new C) = 0"
| "max_vars(Cast C e) = max_vars e"
| "max_vars(Val v) = 0"
| "max_vars(e⇩1 «bop» e⇩2) = max (max_vars e⇩1) (max_vars e⇩2)"
| "max_vars(Var V) = 0"
| "max_vars(V:=e) = max_vars e"
| "max_vars(e∙F{D}) = max_vars e"
| "max_vars(C∙⇩sF{D}) = 0"
| "max_vars(FAss e⇩1 F D e⇩2) = max (max_vars e⇩1) (max_vars e⇩2)"
| "max_vars(SFAss C F D e⇩2) = max_vars e⇩2"
| "max_vars(e∙M(es)) = max (max_vars e) (max_varss es)"
| "max_vars(C∙⇩sM(es)) = max_varss es"
| "max_vars({V:T; e}) = max_vars e + 1"
| "max_vars(e⇩1;;e⇩2) = max (max_vars e⇩1) (max_vars e⇩2)"
| "max_vars(if (e) e⇩1 else e⇩2) =
max (max_vars e) (max (max_vars e⇩1) (max_vars e⇩2))"
| "max_vars(while (b) e) = max (max_vars b) (max_vars e)"
| "max_vars(throw e) = max_vars e"
| "max_vars(try e⇩1 catch(C V) e⇩2) = max (max_vars e⇩1) (max_vars e⇩2 + 1)"
| "max_vars(INIT C (Cs,b) ← e) = max_vars e"
| "max_vars(RI(C,e);Cs ← e') = max (max_vars e) (max_vars e')"
| "max_varss [] = 0"
| "max_varss (e#es) = max (max_vars e) (max_varss es)"
inductive
eval⇩1 :: "J⇩1_prog ⇒ expr⇩1 ⇒ state⇩1 ⇒ expr⇩1 ⇒ state⇩1 ⇒ bool"
("_ ⊢⇩1 ((1⟨_,/_⟩) ⇒/ (1⟨_,/_⟩))" [51,0,0,0,0] 81)
and evals⇩1 :: "J⇩1_prog ⇒ expr⇩1 list ⇒ state⇩1 ⇒ expr⇩1 list ⇒ state⇩1 ⇒ bool"
("_ ⊢⇩1 ((1⟨_,/_⟩) [⇒]/ (1⟨_,/_⟩))" [51,0,0,0,0] 81)
for P :: J⇩1_prog
where
New⇩1:
"⟦ sh C = Some (sfs, Done); new_Addr h = Some a;
P ⊢ C has_fields FDTs; h' = h(a↦blank P C) ⟧
⟹ P ⊢⇩1 ⟨new C,(h,l,sh)⟩ ⇒ ⟨addr a,(h',l,sh)⟩"
| NewFail⇩1:
"⟦ sh C = Some (sfs, Done); new_Addr h = None ⟧ ⟹
P ⊢⇩1 ⟨new C, (h,l,sh)⟩ ⇒ ⟨THROW OutOfMemory,(h,l,sh)⟩"
| NewInit⇩1:
"⟦ ∄sfs. sh C = Some (sfs, Done); P ⊢⇩1 ⟨INIT C ([C],False) ← unit,(h,l,sh)⟩ ⇒ ⟨Val v',(h',l',sh')⟩;
new_Addr h' = Some a; P ⊢ C has_fields FDTs; h'' = h'(a↦blank P C) ⟧
⟹ P ⊢⇩1 ⟨new C,(h,l,sh)⟩ ⇒ ⟨addr a,(h'',l',sh')⟩"
| NewInitOOM⇩1:
"⟦ ∄sfs. sh C = Some (sfs, Done); P ⊢⇩1 ⟨INIT C ([C],False) ← unit,(h,l,sh)⟩ ⇒ ⟨Val v',(h',l',sh')⟩;
new_Addr h' = None; is_class P C ⟧
⟹ P ⊢⇩1 ⟨new C,(h,l,sh)⟩ ⇒ ⟨THROW OutOfMemory,(h',l',sh')⟩"
| NewInitThrow⇩1:
"⟦ ∄sfs. sh C = Some (sfs, Done); P ⊢⇩1 ⟨INIT C ([C],False) ← unit,(h,l,sh)⟩ ⇒ ⟨throw a,s'⟩;
is_class P C ⟧
⟹ P ⊢⇩1 ⟨new C,(h,l,sh)⟩ ⇒ ⟨throw a,s'⟩"
| Cast⇩1:
"⟦ P ⊢⇩1 ⟨e,s⇩0⟩ ⇒ ⟨addr a,(h,l,sh)⟩; h a = Some(D,fs); P ⊢ D ≼⇧* C ⟧
⟹ P ⊢⇩1 ⟨Cast C e,s⇩0⟩ ⇒ ⟨addr a,(h,l,sh)⟩"
| CastNull⇩1:
"P ⊢⇩1 ⟨e,s⇩0⟩ ⇒ ⟨null,s⇩1⟩ ⟹
P ⊢⇩1 ⟨Cast C e,s⇩0⟩ ⇒ ⟨null,s⇩1⟩"
| CastFail⇩1:
"⟦ P ⊢⇩1 ⟨e,s⇩0⟩ ⇒ ⟨addr a,(h,l,sh)⟩; h a = Some(D,fs); ¬ P ⊢ D ≼⇧* C ⟧
⟹ P ⊢⇩1 ⟨Cast C e,s⇩0⟩ ⇒ ⟨THROW ClassCast,(h,l,sh)⟩"
| CastThrow⇩1:
"P ⊢⇩1 ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩ ⟹
P ⊢⇩1 ⟨Cast C e,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩"
| Val⇩1:
"P ⊢⇩1 ⟨Val v,s⟩ ⇒ ⟨Val v,s⟩"
| BinOp⇩1:
"⟦ P ⊢⇩1 ⟨e⇩1,s⇩0⟩ ⇒ ⟨Val v⇩1,s⇩1⟩; P ⊢⇩1 ⟨e⇩2,s⇩1⟩ ⇒ ⟨Val v⇩2,s⇩2⟩; binop(bop,v⇩1,v⇩2) = Some v ⟧
⟹ P ⊢⇩1 ⟨e⇩1 «bop» e⇩2,s⇩0⟩ ⇒ ⟨Val v,s⇩2⟩"
| BinOpThrow⇩1⇩1:
"P ⊢⇩1 ⟨e⇩1,s⇩0⟩ ⇒ ⟨throw e,s⇩1⟩ ⟹
P ⊢⇩1 ⟨e⇩1 «bop» e⇩2, s⇩0⟩ ⇒ ⟨throw e,s⇩1⟩"
| BinOpThrow⇩2⇩1:
"⟦ P ⊢⇩1 ⟨e⇩1,s⇩0⟩ ⇒ ⟨Val v⇩1,s⇩1⟩; P ⊢⇩1 ⟨e⇩2,s⇩1⟩ ⇒ ⟨throw e,s⇩2⟩ ⟧
⟹ P ⊢⇩1 ⟨e⇩1 «bop» e⇩2,s⇩0⟩ ⇒ ⟨throw e,s⇩2⟩"
| Var⇩1:
"⟦ ls!i = v; i < size ls ⟧ ⟹
P ⊢⇩1 ⟨Var i,(h,ls,sh)⟩ ⇒ ⟨Val v,(h,ls,sh)⟩"
| LAss⇩1:
"⟦ P ⊢⇩1 ⟨e,s⇩0⟩ ⇒ ⟨Val v,(h,ls,sh)⟩; i < size ls; ls' = ls[i := v] ⟧
⟹ P ⊢⇩1 ⟨i:= e,s⇩0⟩ ⇒ ⟨unit,(h,ls',sh)⟩"
| LAssThrow⇩1:
"P ⊢⇩1 ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩ ⟹
P ⊢⇩1 ⟨i:= e,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩"
| FAcc⇩1:
"⟦ P ⊢⇩1 ⟨e,s⇩0⟩ ⇒ ⟨addr a,(h,ls,sh)⟩; h a = Some(C,fs);
P ⊢ C has F,NonStatic:t in D;
fs(F,D) = Some v ⟧
⟹ P ⊢⇩1 ⟨e∙F{D},s⇩0⟩ ⇒ ⟨Val v,(h,ls,sh)⟩"
| FAccNull⇩1:
"P ⊢⇩1 ⟨e,s⇩0⟩ ⇒ ⟨null,s⇩1⟩ ⟹
P ⊢⇩1 ⟨e∙F{D},s⇩0⟩ ⇒ ⟨THROW NullPointer,s⇩1⟩"
| FAccThrow⇩1:
"P ⊢⇩1 ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩ ⟹
P ⊢⇩1 ⟨e∙F{D},s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩"
| FAccNone⇩1:
"⟦ P ⊢⇩1 ⟨e,s⇩0⟩ ⇒ ⟨addr a,(h,ls,sh)⟩; h a = Some(C,fs);
¬(∃b t. P ⊢ C has F,b:t in D) ⟧
⟹ P ⊢⇩1 ⟨e∙F{D},s⇩0⟩ ⇒ ⟨THROW NoSuchFieldError,(h,ls,sh)⟩"
| FAccStatic⇩1:
"⟦ P ⊢⇩1 ⟨e,s⇩0⟩ ⇒ ⟨addr a,(h,ls,sh)⟩; h a = Some(C,fs);
P ⊢ C has F,Static:t in D ⟧
⟹ P ⊢⇩1 ⟨e∙F{D},s⇩0⟩ ⇒ ⟨THROW IncompatibleClassChangeError,(h,ls,sh)⟩"
| SFAcc⇩1:
"⟦ P ⊢ C has F,Static:t in D;
sh D = Some (sfs,Done);
sfs F = Some v ⟧
⟹ P ⊢⇩1 ⟨C∙⇩sF{D},(h,ls,sh)⟩ ⇒ ⟨Val v,(h,ls,sh)⟩"
| SFAccInit⇩1:
"⟦ P ⊢ C has F,Static:t in D;
∄sfs. sh D = Some (sfs,Done); P ⊢⇩1 ⟨INIT D ([D],False) ← unit,(h,ls,sh)⟩ ⇒ ⟨Val v',(h',ls',sh')⟩;
sh' D = Some (sfs,i);
sfs F = Some v ⟧
⟹ P ⊢⇩1 ⟨C∙⇩sF{D},(h,ls,sh)⟩ ⇒ ⟨Val v,(h',ls',sh')⟩"
| SFAccInitThrow⇩1:
"⟦ P ⊢ C has F,Static:t in D;
∄sfs. sh D = Some (sfs,Done); P ⊢⇩1 ⟨INIT D ([D],False) ← unit,(h,ls,sh)⟩ ⇒ ⟨throw a,s'⟩ ⟧
⟹ P ⊢⇩1 ⟨C∙⇩sF{D},(h,ls,sh)⟩ ⇒ ⟨throw a,s'⟩"
| SFAccNone⇩1:
"⟦ ¬(∃b t. P ⊢ C has F,b:t in D) ⟧
⟹ P ⊢⇩1 ⟨C∙⇩sF{D},s⟩ ⇒ ⟨THROW NoSuchFieldError,s⟩"
| SFAccNonStatic⇩1:
"⟦ P ⊢ C has F,NonStatic:t in D ⟧
⟹ P ⊢⇩1 ⟨C∙⇩sF{D},s⟩ ⇒ ⟨THROW IncompatibleClassChangeError,s⟩"
| FAss⇩1:
"⟦ P ⊢⇩1 ⟨e⇩1,s⇩0⟩ ⇒ ⟨addr a,s⇩1⟩; P ⊢⇩1 ⟨e⇩2,s⇩1⟩ ⇒ ⟨Val v,(h⇩2,l⇩2,sh⇩2)⟩;
h⇩2 a = Some(C,fs); P ⊢ C has F,NonStatic:t in D;
fs' = fs((F,D)↦v); h⇩2' = h⇩2(a↦(C,fs')) ⟧
⟹ P ⊢⇩1 ⟨e⇩1∙F{D}:=e⇩2,s⇩0⟩ ⇒ ⟨unit,(h⇩2',l⇩2,sh⇩2)⟩"
| FAssNull⇩1:
"⟦ P ⊢⇩1 ⟨e⇩1,s⇩0⟩ ⇒ ⟨null,s⇩1⟩; P ⊢⇩1 ⟨e⇩2,s⇩1⟩ ⇒ ⟨Val v,s⇩2⟩ ⟧ ⟹
P ⊢⇩1 ⟨e⇩1∙F{D}:=e⇩2,s⇩0⟩ ⇒ ⟨THROW NullPointer,s⇩2⟩"
| FAssThrow⇩1⇩1:
"P ⊢⇩1 ⟨e⇩1,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩ ⟹
P ⊢⇩1 ⟨e⇩1∙F{D}:=e⇩2,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩"
| FAssThrow⇩2⇩1:
"⟦ P ⊢⇩1 ⟨e⇩1,s⇩0⟩ ⇒ ⟨Val v,s⇩1⟩; P ⊢⇩1 ⟨e⇩2,s⇩1⟩ ⇒ ⟨throw e',s⇩2⟩ ⟧
⟹ P ⊢⇩1 ⟨e⇩1∙F{D}:=e⇩2,s⇩0⟩ ⇒ ⟨throw e',s⇩2⟩"
| FAssNone⇩1:
"⟦ P ⊢⇩1 ⟨e⇩1,s⇩0⟩ ⇒ ⟨addr a,s⇩1⟩; P ⊢⇩1 ⟨e⇩2,s⇩1⟩ ⇒ ⟨Val v,(h⇩2,l⇩2,sh⇩2)⟩;
h⇩2 a = Some(C,fs); ¬(∃b t. P ⊢ C has F,b:t in D) ⟧
⟹ P ⊢⇩1 ⟨e⇩1∙F{D}:=e⇩2,s⇩0⟩ ⇒ ⟨THROW NoSuchFieldError,(h⇩2,l⇩2,sh⇩2)⟩"
| FAssStatic⇩1:
"⟦ P ⊢⇩1 ⟨e⇩1,s⇩0⟩ ⇒ ⟨addr a,s⇩1⟩; P ⊢⇩1 ⟨e⇩2,s⇩1⟩ ⇒ ⟨Val v,(h⇩2,l⇩2,sh⇩2)⟩;
h⇩2 a = Some(C,fs); P ⊢ C has F,Static:t in D ⟧
⟹ P ⊢⇩1 ⟨e⇩1∙F{D}:=e⇩2,s⇩0⟩ ⇒ ⟨THROW IncompatibleClassChangeError,(h⇩2,l⇩2,sh⇩2)⟩"
| SFAss⇩1:
"⟦ P ⊢⇩1 ⟨e⇩2,s⇩0⟩ ⇒ ⟨Val v,(h⇩1,l⇩1,sh⇩1)⟩;
P ⊢ C has F,Static:t in D;
sh⇩1 D = Some(sfs,Done); sfs' = sfs(F↦v); sh⇩1' = sh⇩1(D↦(sfs',Done)) ⟧
⟹ P ⊢⇩1 ⟨C∙⇩sF{D}:=e⇩2,s⇩0⟩ ⇒ ⟨unit,(h⇩1,l⇩1,sh⇩1')⟩"
| SFAssInit⇩1:
"⟦ P ⊢⇩1 ⟨e⇩2,s⇩0⟩ ⇒ ⟨Val v,(h⇩1,l⇩1,sh⇩1)⟩;
P ⊢ C has F,Static:t in D;
∄sfs. sh⇩1 D = Some(sfs,Done); P ⊢⇩1 ⟨INIT D ([D],False) ← unit,(h⇩1,l⇩1,sh⇩1)⟩ ⇒ ⟨Val v',(h',l',sh')⟩;
sh' D = Some(sfs,i);
sfs' = sfs(F↦v); sh'' = sh'(D↦(sfs',i)) ⟧
⟹ P ⊢⇩1 ⟨C∙⇩sF{D}:=e⇩2,s⇩0⟩ ⇒ ⟨unit,(h',l',sh'')⟩"
| SFAssInitThrow⇩1:
"⟦ P ⊢⇩1 ⟨e⇩2,s⇩0⟩ ⇒ ⟨Val v,(h⇩1,l⇩1,sh⇩1)⟩;
P ⊢ C has F,Static:t in D;
∄sfs. sh⇩1 D = Some(sfs,Done); P ⊢⇩1 ⟨INIT D ([D],False) ← unit,(h⇩1,l⇩1,sh⇩1)⟩ ⇒ ⟨throw a,s'⟩ ⟧
⟹ P ⊢⇩1 ⟨C∙⇩sF{D}:=e⇩2,s⇩0⟩ ⇒ ⟨throw a,s'⟩"
| SFAssThrow⇩1:
"P ⊢⇩1 ⟨e⇩2,s⇩0⟩ ⇒ ⟨throw e',s⇩2⟩
⟹ P ⊢⇩1 ⟨C∙⇩sF{D}:=e⇩2,s⇩0⟩ ⇒ ⟨throw e',s⇩2⟩"
| SFAssNone⇩1:
"⟦ P ⊢⇩1 ⟨e⇩2,s⇩0⟩ ⇒ ⟨Val v,(h⇩2,l⇩2,sh⇩2)⟩;
¬(∃b t. P ⊢ C has F,b:t in D) ⟧
⟹ P ⊢⇩1 ⟨C∙⇩sF{D}:=e⇩2,s⇩0⟩ ⇒ ⟨THROW NoSuchFieldError,(h⇩2,l⇩2,sh⇩2)⟩"
| SFAssNonStatic⇩1:
"⟦ P ⊢⇩1 ⟨e⇩2,s⇩0⟩ ⇒ ⟨Val v,(h⇩2,l⇩2,sh⇩2)⟩;
P ⊢ C has F,NonStatic:t in D ⟧
⟹ P ⊢⇩1 ⟨C∙⇩sF{D}:=e⇩2,s⇩0⟩ ⇒ ⟨THROW IncompatibleClassChangeError,(h⇩2,l⇩2,sh⇩2)⟩"
| CallObjThrow⇩1:
"P ⊢⇩1 ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩ ⟹
P ⊢⇩1 ⟨e∙M(es),s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩"
| CallNull⇩1:
"⟦ P ⊢⇩1 ⟨e,s⇩0⟩ ⇒ ⟨null,s⇩1⟩; P ⊢⇩1 ⟨es,s⇩1⟩ [⇒] ⟨map Val vs,s⇩2⟩ ⟧
⟹ P ⊢⇩1 ⟨e∙M(es),s⇩0⟩ ⇒ ⟨THROW NullPointer,s⇩2⟩"
| Call⇩1:
"⟦ P ⊢⇩1 ⟨e,s⇩0⟩ ⇒ ⟨addr a,s⇩1⟩; P ⊢⇩1 ⟨es,s⇩1⟩ [⇒] ⟨map Val vs,(h⇩2,ls⇩2,sh⇩2)⟩;
h⇩2 a = Some(C,fs); P ⊢ C sees M,NonStatic:Ts→T = body in D;
size vs = size Ts; ls⇩2' = (Addr a) # vs @ replicate (max_vars body) undefined;
P ⊢⇩1 ⟨body,(h⇩2,ls⇩2',sh⇩2)⟩ ⇒ ⟨e',(h⇩3,ls⇩3,sh⇩3)⟩ ⟧
⟹ P ⊢⇩1 ⟨e∙M(es),s⇩0⟩ ⇒ ⟨e',(h⇩3,ls⇩2,sh⇩3)⟩"
| CallParamsThrow⇩1:
"⟦ P ⊢⇩1 ⟨e,s⇩0⟩ ⇒ ⟨Val v,s⇩1⟩; P ⊢⇩1 ⟨es,s⇩1⟩ [⇒] ⟨es',s⇩2⟩;
es' = map Val vs @ throw ex # es⇩2 ⟧
⟹ P ⊢⇩1 ⟨e∙M(es),s⇩0⟩ ⇒ ⟨throw ex,s⇩2⟩"
| CallNone⇩1:
"⟦ P ⊢⇩1 ⟨e,s⇩0⟩ ⇒ ⟨addr a,s⇩1⟩; P ⊢⇩1 ⟨ps,s⇩1⟩ [⇒] ⟨map Val vs,(h⇩2,ls⇩2,sh⇩2)⟩;
h⇩2 a = Some(C,fs); ¬(∃b Ts T body D. P ⊢ C sees M,b:Ts→T = body in D) ⟧
⟹ P ⊢⇩1 ⟨e∙M(ps),s⇩0⟩ ⇒ ⟨THROW NoSuchMethodError,(h⇩2,ls⇩2,sh⇩2)⟩"
| CallStatic⇩1:
"⟦ P ⊢⇩1 ⟨e,s⇩0⟩ ⇒ ⟨addr a,s⇩1⟩; P ⊢⇩1 ⟨ps,s⇩1⟩ [⇒] ⟨map Val vs,(h⇩2,ls⇩2,sh⇩2)⟩;
h⇩2 a = Some(C,fs); P ⊢ C sees M,Static:Ts→T = body in D ⟧
⟹ P ⊢⇩1 ⟨e∙M(ps),s⇩0⟩ ⇒ ⟨THROW IncompatibleClassChangeError,(h⇩2,ls⇩2,sh⇩2)⟩"
| SCallParamsThrow⇩1:
"⟦ P ⊢⇩1 ⟨es,s⇩0⟩ [⇒] ⟨es',s⇩2⟩; es' = map Val vs @ throw ex # es⇩2 ⟧
⟹ P ⊢⇩1 ⟨C∙⇩sM(es),s⇩0⟩ ⇒ ⟨throw ex,s⇩2⟩"
| SCallNone⇩1:
"⟦ P ⊢⇩1 ⟨ps,s⇩0⟩ [⇒] ⟨map Val vs,s⇩2⟩;
¬(∃b Ts T body D. P ⊢ C sees M,b:Ts→T = body in D) ⟧
⟹ P ⊢⇩1 ⟨C∙⇩sM(ps),s⇩0⟩ ⇒ ⟨THROW NoSuchMethodError,s⇩2⟩"
| SCallNonStatic⇩1:
"⟦ P ⊢⇩1 ⟨ps,s⇩0⟩ [⇒] ⟨map Val vs,s⇩2⟩;
P ⊢ C sees M,NonStatic:Ts→T = body in D ⟧
⟹ P ⊢⇩1 ⟨C∙⇩sM(ps),s⇩0⟩ ⇒ ⟨THROW IncompatibleClassChangeError,s⇩2⟩"
| SCallInitThrow⇩1:
"⟦ P ⊢⇩1 ⟨ps,s⇩0⟩ [⇒] ⟨map Val vs,(h⇩1,ls⇩1,sh⇩1)⟩;
P ⊢ C sees M,Static:Ts→T = body in D;
∄sfs. sh⇩1 D = Some(sfs,Done); M ≠ clinit;
P ⊢⇩1 ⟨INIT D ([D],False) ← unit,(h⇩1,ls⇩1,sh⇩1)⟩ ⇒ ⟨throw a,s'⟩ ⟧
⟹ P ⊢⇩1 ⟨C∙⇩sM(ps),s⇩0⟩ ⇒ ⟨throw a,s'⟩"
| SCallInit⇩1:
"⟦ P ⊢⇩1 ⟨ps,s⇩0⟩ [⇒] ⟨map Val vs,(h⇩1,ls⇩1,sh⇩1)⟩;
P ⊢ C sees M,Static:Ts→T = body in D;
∄sfs. sh⇩1 D = Some(sfs,Done); M ≠ clinit;
P ⊢⇩1 ⟨INIT D ([D],False) ← unit,(h⇩1,ls⇩1,sh⇩1)⟩ ⇒ ⟨Val v',(h⇩2,ls⇩2,sh⇩2)⟩;
size vs = size Ts; ls⇩2' = vs @ replicate (max_vars body) undefined;
P ⊢⇩1 ⟨body,(h⇩2,ls⇩2',sh⇩2)⟩ ⇒ ⟨e',(h⇩3,ls⇩3,sh⇩3)⟩ ⟧
⟹ P ⊢⇩1 ⟨C∙⇩sM(ps),s⇩0⟩ ⇒ ⟨e',(h⇩3,ls⇩2,sh⇩3)⟩"
| SCall⇩1:
"⟦ P ⊢⇩1 ⟨ps,s⇩0⟩ [⇒] ⟨map Val vs,(h⇩2,ls⇩2,sh⇩2)⟩;
P ⊢ C sees M,Static:Ts→T = body in D;
sh⇩2 D = Some(sfs,Done) ∨ (M = clinit ∧ sh⇩2 D = ⌊(sfs, Processing)⌋);
size vs = size Ts; ls⇩2' = vs @ replicate (max_vars body) undefined;
P ⊢⇩1 ⟨body,(h⇩2,ls⇩2',sh⇩2)⟩ ⇒ ⟨e',(h⇩3,ls⇩3,sh⇩3)⟩ ⟧
⟹ P ⊢⇩1 ⟨C∙⇩sM(ps),s⇩0⟩ ⇒ ⟨e',(h⇩3,ls⇩2,sh⇩3)⟩"
| Block⇩1:
"P ⊢⇩1 ⟨e,s⇩0⟩ ⇒ ⟨e',s⇩1⟩ ⟹ P ⊢⇩1 ⟨Block i T e,s⇩0⟩ ⇒ ⟨e',s⇩1⟩"
| Seq⇩1:
"⟦ P ⊢⇩1 ⟨e⇩0,s⇩0⟩ ⇒ ⟨Val v,s⇩1⟩; P ⊢⇩1 ⟨e⇩1,s⇩1⟩ ⇒ ⟨e⇩2,s⇩2⟩ ⟧
⟹ P ⊢⇩1 ⟨e⇩0;;e⇩1,s⇩0⟩ ⇒ ⟨e⇩2,s⇩2⟩"
| SeqThrow⇩1:
"P ⊢⇩1 ⟨e⇩0,s⇩0⟩ ⇒ ⟨throw e,s⇩1⟩ ⟹
P ⊢⇩1 ⟨e⇩0;;e⇩1,s⇩0⟩ ⇒ ⟨throw e,s⇩1⟩"
| CondT⇩1:
"⟦ P ⊢⇩1 ⟨e,s⇩0⟩ ⇒ ⟨true,s⇩1⟩; P ⊢⇩1 ⟨e⇩1,s⇩1⟩ ⇒ ⟨e',s⇩2⟩ ⟧
⟹ P ⊢⇩1 ⟨if (e) e⇩1 else e⇩2,s⇩0⟩ ⇒ ⟨e',s⇩2⟩"
| CondF⇩1:
"⟦ P ⊢⇩1 ⟨e,s⇩0⟩ ⇒ ⟨false,s⇩1⟩; P ⊢⇩1 ⟨e⇩2,s⇩1⟩ ⇒ ⟨e',s⇩2⟩ ⟧
⟹ P ⊢⇩1 ⟨if (e) e⇩1 else e⇩2,s⇩0⟩ ⇒ ⟨e',s⇩2⟩"
| CondThrow⇩1:
"P ⊢⇩1 ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩ ⟹
P ⊢⇩1 ⟨if (e) e⇩1 else e⇩2, s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩"
| WhileF⇩1:
"P ⊢⇩1 ⟨e,s⇩0⟩ ⇒ ⟨false,s⇩1⟩ ⟹
P ⊢⇩1 ⟨while (e) c,s⇩0⟩ ⇒ ⟨unit,s⇩1⟩"
| WhileT⇩1:
"⟦ P ⊢⇩1 ⟨e,s⇩0⟩ ⇒ ⟨true,s⇩1⟩; P ⊢⇩1 ⟨c,s⇩1⟩ ⇒ ⟨Val v⇩1,s⇩2⟩;
P ⊢⇩1 ⟨while (e) c,s⇩2⟩ ⇒ ⟨e⇩3,s⇩3⟩ ⟧
⟹ P ⊢⇩1 ⟨while (e) c,s⇩0⟩ ⇒ ⟨e⇩3,s⇩3⟩"
| WhileCondThrow⇩1:
"P ⊢⇩1 ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩ ⟹
P ⊢⇩1 ⟨while (e) c,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩"
| WhileBodyThrow⇩1:
"⟦ P ⊢⇩1 ⟨e,s⇩0⟩ ⇒ ⟨true,s⇩1⟩; P ⊢⇩1 ⟨c,s⇩1⟩ ⇒ ⟨throw e',s⇩2⟩⟧
⟹ P ⊢⇩1 ⟨while (e) c,s⇩0⟩ ⇒ ⟨throw e',s⇩2⟩"
| Throw⇩1:
"P ⊢⇩1 ⟨e,s⇩0⟩ ⇒ ⟨addr a,s⇩1⟩ ⟹
P ⊢⇩1 ⟨throw e,s⇩0⟩ ⇒ ⟨Throw a,s⇩1⟩"
| ThrowNull⇩1:
"P ⊢⇩1 ⟨e,s⇩0⟩ ⇒ ⟨null,s⇩1⟩ ⟹
P ⊢⇩1 ⟨throw e,s⇩0⟩ ⇒ ⟨THROW NullPointer,s⇩1⟩"
| ThrowThrow⇩1:
"P ⊢⇩1 ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩ ⟹
P ⊢⇩1 ⟨throw e,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩"
| Try⇩1:
"P ⊢⇩1 ⟨e⇩1,s⇩0⟩ ⇒ ⟨Val v⇩1,s⇩1⟩ ⟹
P ⊢⇩1 ⟨try e⇩1 catch(C i) e⇩2,s⇩0⟩ ⇒ ⟨Val v⇩1,s⇩1⟩"
| TryCatch⇩1:
"⟦ P ⊢⇩1 ⟨e⇩1,s⇩0⟩ ⇒ ⟨Throw a,(h⇩1,ls⇩1,sh⇩1)⟩;
h⇩1 a = Some(D,fs); P ⊢ D ≼⇧* C; i < length ls⇩1;
P ⊢⇩1 ⟨e⇩2,(h⇩1,ls⇩1[i:=Addr a],sh⇩1)⟩ ⇒ ⟨e⇩2',(h⇩2,ls⇩2,sh⇩2)⟩ ⟧
⟹ P ⊢⇩1 ⟨try e⇩1 catch(C i) e⇩2,s⇩0⟩ ⇒ ⟨e⇩2',(h⇩2,ls⇩2,sh⇩2)⟩"
| TryThrow⇩1:
"⟦ P ⊢⇩1 ⟨e⇩1,s⇩0⟩ ⇒ ⟨Throw a,(h⇩1,ls⇩1,sh⇩1)⟩; h⇩1 a = Some(D,fs); ¬ P ⊢ D ≼⇧* C ⟧
⟹ P ⊢⇩1 ⟨try e⇩1 catch(C i) e⇩2,s⇩0⟩ ⇒ ⟨Throw a,(h⇩1,ls⇩1,sh⇩1)⟩"
| Nil⇩1:
"P ⊢⇩1 ⟨[],s⟩ [⇒] ⟨[],s⟩"
| Cons⇩1:
"⟦ P ⊢⇩1 ⟨e,s⇩0⟩ ⇒ ⟨Val v,s⇩1⟩; P ⊢⇩1 ⟨es,s⇩1⟩ [⇒] ⟨es',s⇩2⟩ ⟧
⟹ P ⊢⇩1 ⟨e#es,s⇩0⟩ [⇒] ⟨Val v # es',s⇩2⟩"
| ConsThrow⇩1:
"P ⊢⇩1 ⟨e,s⇩0⟩ ⇒ ⟨throw e',s⇩1⟩ ⟹
P ⊢⇩1 ⟨e#es,s⇩0⟩ [⇒] ⟨throw e' # es, s⇩1⟩"
| InitFinal⇩1:
"P ⊢⇩1 ⟨e,s⟩ ⇒ ⟨e',s'⟩ ⟹ P ⊢⇩1 ⟨INIT C (Nil,b) ← e,s⟩ ⇒ ⟨e',s'⟩"
| InitNone⇩1:
"⟦ sh C = None; P ⊢⇩1 ⟨INIT C' (C#Cs,False) ← e,(h,l,sh(C ↦ (sblank P C, Prepared)))⟩ ⇒ ⟨e',s'⟩ ⟧
⟹ P ⊢⇩1 ⟨INIT C' (C#Cs,False) ← e,(h,l,sh)⟩ ⇒ ⟨e',s'⟩"
| InitDone⇩1:
"⟦ sh C = Some(sfs,Done); P ⊢⇩1 ⟨INIT C' (Cs,True) ← e,(h,l,sh)⟩ ⇒ ⟨e',s'⟩ ⟧
⟹ P ⊢⇩1 ⟨INIT C' (C#Cs,False) ← e,(h,l,sh)⟩ ⇒ ⟨e',s'⟩"
| InitProcessing⇩1:
"⟦ sh C = Some(sfs,Processing); P ⊢⇩1 ⟨INIT C' (Cs,True) ← e,(h,l,sh)⟩ ⇒ ⟨e',s'⟩ ⟧
⟹ P ⊢⇩1 ⟨INIT C' (C#Cs,False) ← e,(h,l,sh)⟩ ⇒ ⟨e',s'⟩"
| InitError⇩1:
"⟦ sh C = Some(sfs,Error);
P ⊢⇩1 ⟨RI (C, THROW NoClassDefFoundError);Cs ← e,(h,l,sh)⟩ ⇒ ⟨e',s'⟩ ⟧
⟹ P ⊢⇩1 ⟨INIT C' (C#Cs,False) ← e,(h,l,sh)⟩ ⇒ ⟨e',s'⟩"
| InitObject⇩1:
"⟦ sh C = Some(sfs,Prepared);
C = Object;
sh' = sh(C ↦ (sfs,Processing));
P ⊢⇩1 ⟨INIT C' (C#Cs,True) ← e,(h,l,sh')⟩ ⇒ ⟨e',s'⟩ ⟧
⟹ P ⊢⇩1 ⟨INIT C' (C#Cs,False) ← e,(h,l,sh)⟩ ⇒ ⟨e',s'⟩"
| InitNonObject⇩1:
"⟦ sh C = Some(sfs,Prepared);
C ≠ Object;
class P C = Some (D,r);
sh' = sh(C ↦ (sfs,Processing));
P ⊢⇩1 ⟨INIT C' (D#C#Cs,False) ← e,(h,l,sh')⟩ ⇒ ⟨e',s'⟩ ⟧
⟹ P ⊢⇩1 ⟨INIT C' (C#Cs,False) ← e,(h,l,sh)⟩ ⇒ ⟨e',s'⟩"
| InitRInit⇩1:
"P ⊢⇩1 ⟨RI (C,C∙⇩sclinit([]));Cs ← e,(h,l,sh)⟩ ⇒ ⟨e',s'⟩
⟹ P ⊢⇩1 ⟨INIT C' (C#Cs,True) ← e,(h,l,sh)⟩ ⇒ ⟨e',s'⟩"
| RInit⇩1:
"⟦ P ⊢⇩1 ⟨e,s⟩ ⇒ ⟨Val v, (h',l',sh')⟩;
sh' C = Some(sfs, i); sh'' = sh'(C ↦ (sfs, Done));
C' = last(C#Cs);
P ⊢⇩1 ⟨INIT C' (Cs,True) ← e', (h',l',sh'')⟩ ⇒ ⟨e⇩1,s⇩1⟩ ⟧
⟹ P ⊢⇩1 ⟨RI (C,e);Cs ← e',s⟩ ⇒ ⟨e⇩1,s⇩1⟩"
| RInitInitFail⇩1:
"⟦ P ⊢⇩1 ⟨e,s⟩ ⇒ ⟨throw a, (h',l',sh')⟩;
sh' C = Some(sfs, i); sh'' = sh'(C ↦ (sfs, Error));
P ⊢⇩1 ⟨RI (D,throw a);Cs ← e', (h',l',sh'')⟩ ⇒ ⟨e⇩1,s⇩1⟩ ⟧
⟹ P ⊢⇩1 ⟨RI (C,e);D#Cs ← e',s⟩ ⇒ ⟨e⇩1,s⇩1⟩"
| RInitFailFinal⇩1:
"⟦ P ⊢⇩1 ⟨e,s⟩ ⇒ ⟨throw a, (h',l',sh')⟩;
sh' C = Some(sfs, i); sh'' = sh'(C ↦ (sfs, Error)) ⟧
⟹ P ⊢⇩1 ⟨RI (C,e);Nil ← e',s⟩ ⇒ ⟨throw a, (h',l',sh'')⟩"
lemmas eval⇩1_evals⇩1_induct = eval⇩1_evals⇩1.induct [split_format (complete)]
and eval⇩1_evals⇩1_inducts = eval⇩1_evals⇩1.inducts [split_format (complete)]
inductive_cases eval⇩1_cases [cases set]:
"P ⊢⇩1 ⟨new C,s⟩ ⇒ ⟨e',s'⟩"
"P ⊢⇩1 ⟨Cast C e,s⟩ ⇒ ⟨e',s'⟩"
"P ⊢⇩1 ⟨Val v,s⟩ ⇒ ⟨e',s'⟩"
"P ⊢⇩1 ⟨e⇩1 «bop» e⇩2,s⟩ ⇒ ⟨e',s'⟩"
"P ⊢⇩1 ⟨Var v,s⟩ ⇒ ⟨e',s'⟩"
"P ⊢⇩1 ⟨V:=e,s⟩ ⇒ ⟨e',s'⟩"
"P ⊢⇩1 ⟨e∙F{D},s⟩ ⇒ ⟨e',s'⟩"
"P ⊢⇩1 ⟨C∙⇩sF{D},s⟩ ⇒ ⟨e',s'⟩"
"P ⊢⇩1 ⟨e⇩1∙F{D}:=e⇩2,s⟩ ⇒ ⟨e',s'⟩"
"P ⊢⇩1 ⟨C∙⇩sF{D}:=e⇩2,s⟩ ⇒ ⟨e',s'⟩"
"P ⊢⇩1 ⟨e∙M(es),s⟩ ⇒ ⟨e',s'⟩"
"P ⊢⇩1 ⟨C∙⇩sM(es),s⟩ ⇒ ⟨e',s'⟩"
"P ⊢⇩1 ⟨{V:T;e⇩1},s⟩ ⇒ ⟨e',s'⟩"
"P ⊢⇩1 ⟨e⇩1;;e⇩2,s⟩ ⇒ ⟨e',s'⟩"
"P ⊢⇩1 ⟨if (e) e⇩1 else e⇩2,s⟩ ⇒ ⟨e',s'⟩"
"P ⊢⇩1 ⟨while (b) c,s⟩ ⇒ ⟨e',s'⟩"
"P ⊢⇩1 ⟨throw e,s⟩ ⇒ ⟨e',s'⟩"
"P ⊢⇩1 ⟨try e⇩1 catch(C V) e⇩2,s⟩ ⇒ ⟨e',s'⟩"
"P ⊢⇩1 ⟨INIT C (Cs,b) ← e,s⟩ ⇒ ⟨e',s'⟩"
"P ⊢⇩1 ⟨RI (C,e);Cs ← e⇩0,s⟩ ⇒ ⟨e',s'⟩"
inductive_cases evals⇩1_cases [cases set]:
"P ⊢⇩1 ⟨[],s⟩ [⇒] ⟨e',s'⟩"
"P ⊢⇩1 ⟨e#es,s⟩ [⇒] ⟨e',s'⟩"
lemma eval⇩1_final: "P ⊢⇩1 ⟨e,s⟩ ⇒ ⟨e',s'⟩ ⟹ final e'"
and evals⇩1_final: "P ⊢⇩1 ⟨es,s⟩ [⇒] ⟨es',s'⟩ ⟹ finals es'"
by(induct rule:eval⇩1_evals⇩1.inducts, simp_all)
lemma eval⇩1_final_same: "⟦ P ⊢⇩1 ⟨e,s⟩ ⇒ ⟨e',s'⟩; final e ⟧ ⟹ e = e' ∧ s = s'"
apply(erule finalE)
using eval⇩1_cases(3) apply blast
by (metis eval⇩1_cases(3,17) exp.distinct(101) exp.inject(3) val.distinct(13))
subsection "Property preservation"
lemma eval⇩1_preserves_len:
"P ⊢⇩1 ⟨e⇩0,(h⇩0,ls⇩0,sh⇩0)⟩ ⇒ ⟨e⇩1,(h⇩1,ls⇩1,sh⇩1)⟩ ⟹ length ls⇩0 = length ls⇩1"
and evals⇩1_preserves_len:
"P ⊢⇩1 ⟨es⇩0,(h⇩0,ls⇩0,sh⇩0)⟩ [⇒] ⟨es⇩1,(h⇩1,ls⇩1,sh⇩1)⟩ ⟹ length ls⇩0 = length ls⇩1"
by (induct rule:eval⇩1_evals⇩1_inducts, simp_all)
lemma evals⇩1_preserves_elen:
"⋀es' s s'. P ⊢⇩1 ⟨es,s⟩ [⇒] ⟨es',s'⟩ ⟹ length es = length es'"
apply(induct es type:list)
apply (auto elim:evals⇩1.cases)
done
lemma clinit⇩1_loc_pres:
"P ⊢⇩1 ⟨C⇩0∙⇩sclinit([]),(h,l,sh)⟩ ⇒ ⟨e',(h',l',sh')⟩ ⟹ l = l'"
by(auto elim!: eval⇩1_cases(12) evals⇩1_cases(1))
lemma
shows init⇩1_ri⇩1_same_loc: "P ⊢⇩1 ⟨e,(h,l,sh)⟩ ⇒ ⟨e',(h',l',sh')⟩
⟹ (⋀C Cs b M a. e = INIT C (Cs,b) ← unit ∨ e = C∙⇩sM([]) ∨ e = RI (C,Throw a) ; Cs ← unit
∨ e = RI (C,C∙⇩sclinit([])) ; Cs ← unit
⟹ l = l')"
and "P ⊢⇩1 ⟨es,(h,l,sh)⟩ [⇒] ⟨es',(h',l',sh')⟩ ⟹ True"
proof(induct rule: eval⇩1_evals⇩1_inducts)
case (RInitInitFail⇩1 e h l sh a')
then show ?case using eval⇩1_final[of _ _ _ "throw a'"]
by(fastforce dest: eval⇩1_final_same[of _ "Throw a"])
next
case RInitFailFinal⇩1 then show ?case by(auto dest: eval⇩1_final_same)
qed(auto dest: evals⇩1_cases eval⇩1_cases(17) eval⇩1_final_same)
lemma init⇩1_same_loc: "P ⊢⇩1 ⟨INIT C (Cs,b) ← unit,(h,l,sh)⟩ ⇒ ⟨e',(h',l',sh')⟩ ⟹ l = l'"
by(simp add: init⇩1_ri⇩1_same_loc)
theorem eval⇩1_hext: "P ⊢⇩1 ⟨e,(h,l,sh)⟩ ⇒ ⟨e',(h',l',sh')⟩ ⟹ h ⊴ h'"
and evals⇩1_hext: "P ⊢⇩1 ⟨es,(h,l,sh)⟩ [⇒] ⟨es',(h',l',sh')⟩ ⟹ h ⊴ h'"
proof (induct rule: eval⇩1_evals⇩1_inducts)
case New⇩1 thus ?case
by(fastforce intro!: hext_new intro:LeastI simp:new_Addr_def
split:if_split_asm simp del:fun_upd_apply)
next
case NewInit⇩1 thus ?case
by (meson hext_new hext_trans new_Addr_SomeD)
next
case FAss⇩1 thus ?case
by(auto simp:sym[THEN hext_upd_obj] simp del:fun_upd_apply
elim!: hext_trans)
qed (auto elim!: hext_trans)
subsection "Initialization"
lemma rinit⇩1_throw:
"P⇩1 ⊢⇩1 ⟨RI (D,Throw xa) ; Cs ← e,(h, l, sh)⟩ ⇒ ⟨e',(h', l', sh')⟩
⟹ e' = Throw xa"
apply(induct Cs arbitrary: D h l sh h' l' sh')
apply(drule eval⇩1_cases(20), auto elim: eval⇩1_cases)
apply(drule eval⇩1_cases(20), auto elim: eval⇩1_cases dest: eval⇩1_final_same simp: final_def)
done
lemma rinit⇩1_throwE:
"P ⊢⇩1 ⟨RI (C,throw e) ; Cs ← e⇩0,s⟩ ⇒ ⟨e',s'⟩
⟹ ∃a s⇩t. e' = throw a ∧ P ⊢⇩1 ⟨throw e,s⟩ ⇒ ⟨throw a,s⇩t⟩"
proof(induct Cs arbitrary: C e s)
case Nil
then show ?case
proof(rule eval⇩1_cases(20))
fix v h' l' sh' assume "P ⊢⇩1 ⟨throw e,s⟩ ⇒ ⟨Val v,(h', l', sh')⟩"
then show ?case using eval⇩1_cases(17) by blast
qed(auto)
next
case (Cons C' Cs')
show ?case using Cons.prems(1)
proof(rule eval⇩1_cases(20))
fix v h' l' sh' assume "P ⊢⇩1 ⟨throw e,s⟩ ⇒ ⟨Val v,(h', l', sh')⟩"
then show ?case using eval⇩1_cases(17) by blast
next
fix a h' l' sh' sfs i D Cs''
assume e''step: "P ⊢⇩1 ⟨throw e,s⟩ ⇒ ⟨throw a,(h', l', sh')⟩"
and shC: "sh' C = ⌊(sfs, i)⌋"
and riD: "P ⊢⇩1 ⟨RI (D,throw a) ; Cs'' ← e⇩0,(h', l', sh'(C ↦ (sfs, Error)))⟩ ⇒ ⟨e',s'⟩"
and "C' # Cs' = D # Cs''"
then show ?thesis using Cons.hyps eval⇩1_final eval⇩1_final_same by blast
qed(simp)
qed
end
Theory J1WellForm
section ‹ Well-Formedness of Intermediate Language ›
theory J1WellForm
imports "../J/JWellForm" J1
begin
subsection "Well-Typedness"
type_synonym
env⇩1 = "ty list"
inductive
WT⇩1 :: "[J⇩1_prog,env⇩1, expr⇩1 , ty ] ⇒ bool"
("(_,_ ⊢⇩1/ _ :: _)" [51,51,51]50)
and WTs⇩1 :: "[J⇩1_prog,env⇩1, expr⇩1 list, ty list] ⇒ bool"
("(_,_ ⊢⇩1/ _ [::] _)" [51,51,51]50)
for P :: J⇩1_prog
where
WTNew⇩1:
"is_class P C ⟹
P,E ⊢⇩1 new C :: Class C"
| WTCast⇩1:
"⟦ P,E ⊢⇩1 e :: Class D; is_class P C; P ⊢ C ≼⇧* D ∨ P ⊢ D ≼⇧* C ⟧
⟹ P,E ⊢⇩1 Cast C e :: Class C"
| WTVal⇩1:
"typeof v = Some T ⟹
P,E ⊢⇩1 Val v :: T"
| WTVar⇩1:
"⟦ E!i = T; i < size E ⟧
⟹ P,E ⊢⇩1 Var i :: T"
| WTBinOp⇩1:
"⟦ P,E ⊢⇩1 e⇩1 :: T⇩1; P,E ⊢⇩1 e⇩2 :: T⇩2;
case bop of Eq ⇒ (P ⊢ T⇩1 ≤ T⇩2 ∨ P ⊢ T⇩2 ≤ T⇩1) ∧ T = Boolean
| Add ⇒ T⇩1 = Integer ∧ T⇩2 = Integer ∧ T = Integer ⟧
⟹ P,E ⊢⇩1 e⇩1 «bop» e⇩2 :: T"
| WTLAss⇩1:
"⟦ E!i = T; i < size E; P,E ⊢⇩1 e :: T'; P ⊢ T' ≤ T ⟧
⟹ P,E ⊢⇩1 i:=e :: Void"
| WTFAcc⇩1:
"⟦ P,E ⊢⇩1 e :: Class C; P ⊢ C sees F,NonStatic:T in D ⟧
⟹ P,E ⊢⇩1 e∙F{D} :: T"
| WTSFAcc⇩1:
"⟦ P ⊢ C sees F,Static:T in D ⟧
⟹ P,E ⊢⇩1 C∙⇩sF{D} :: T"
| WTFAss⇩1:
"⟦ P,E ⊢⇩1 e⇩1 :: Class C; P ⊢ C sees F,NonStatic:T in D; P,E ⊢⇩1 e⇩2 :: T'; P ⊢ T' ≤ T ⟧
⟹ P,E ⊢⇩1 e⇩1∙F{D} := e⇩2 :: Void"
| WTSFAss⇩1:
"⟦ P ⊢ C sees F,Static:T in D; P,E ⊢⇩1 e⇩2 :: T'; P ⊢ T' ≤ T ⟧
⟹ P,E ⊢⇩1 C∙⇩sF{D}:=e⇩2 :: Void"
| WTCall⇩1:
"⟦ P,E ⊢⇩1 e :: Class C; P ⊢ C sees M,NonStatic:Ts' → T = m in D;
P,E ⊢⇩1 es [::] Ts; P ⊢ Ts [≤] Ts' ⟧
⟹ P,E ⊢⇩1 e∙M(es) :: T"
| WTSCall⇩1:
"⟦ P ⊢ C sees M,Static:Ts → T = m in D;
P,E ⊢⇩1 es [::] Ts'; P ⊢ Ts' [≤] Ts; M ≠ clinit ⟧
⟹ P,E ⊢⇩1 C∙⇩sM(es) :: T"
| WTBlock⇩1:
"⟦ is_type P T; P,E@[T] ⊢⇩1 e::T' ⟧
⟹ P,E ⊢⇩1 {i:T; e} :: T'"
| WTSeq⇩1:
"⟦ P,E ⊢⇩1 e⇩1::T⇩1; P,E ⊢⇩1 e⇩2::T⇩2 ⟧
⟹ P,E ⊢⇩1 e⇩1;;e⇩2 :: T⇩2"
| WTCond⇩1:
"⟦ P,E ⊢⇩1 e :: Boolean; P,E ⊢⇩1 e⇩1::T⇩1; P,E ⊢⇩1 e⇩2::T⇩2;
P ⊢ T⇩1 ≤ T⇩2 ∨ P ⊢ T⇩2 ≤ T⇩1; P ⊢ T⇩1 ≤ T⇩2 ⟶ T = T⇩2; P ⊢ T⇩2 ≤ T⇩1 ⟶ T = T⇩1 ⟧
⟹ P,E ⊢⇩1 if (e) e⇩1 else e⇩2 :: T"
| WTWhile⇩1:
"⟦ P,E ⊢⇩1 e :: Boolean; P,E ⊢⇩1 c::T ⟧
⟹ P,E ⊢⇩1 while (e) c :: Void"
| WTThrow⇩1:
"P,E ⊢⇩1 e :: Class C ⟹
P,E ⊢⇩1 throw e :: Void"
| WTTry⇩1:
"⟦ P,E ⊢⇩1 e⇩1 :: T; P,E@[Class C] ⊢⇩1 e⇩2 :: T; is_class P C ⟧
⟹ P,E ⊢⇩1 try e⇩1 catch(C i) e⇩2 :: T"
| WTNil⇩1:
"P,E ⊢⇩1 [] [::] []"
| WTCons⇩1:
"⟦ P,E ⊢⇩1 e :: T; P,E ⊢⇩1 es [::] Ts ⟧
⟹ P,E ⊢⇩1 e#es [::] T#Ts"
declare WT⇩1_WTs⇩1.intros[intro!]
declare WTNil⇩1[iff]
lemmas WT⇩1_WTs⇩1_induct = WT⇩1_WTs⇩1.induct [split_format (complete)]
and WT⇩1_WTs⇩1_inducts = WT⇩1_WTs⇩1.inducts [split_format (complete)]
inductive_cases eee[elim!]:
"P,E ⊢⇩1 Val v :: T"
"P,E ⊢⇩1 Var i :: T"
"P,E ⊢⇩1 Cast D e :: T"
"P,E ⊢⇩1 i:=e :: T"
"P,E ⊢⇩1 {i:U; e} :: T"
"P,E ⊢⇩1 e⇩1;;e⇩2 :: T"
"P,E ⊢⇩1 if (e) e⇩1 else e⇩2 :: T"
"P,E ⊢⇩1 while (e) c :: T"
"P,E ⊢⇩1 throw e :: T"
"P,E ⊢⇩1 try e⇩1 catch(C i) e⇩2 :: T"
"P,E ⊢⇩1 e∙F{D} :: T"
"P,E ⊢⇩1 C∙⇩sF{D} :: T"
"P,E ⊢⇩1 e⇩1∙F{D}:=e⇩2 :: T"
"P,E ⊢⇩1 C∙⇩sF{D}:=e⇩2 :: T"
"P,E ⊢⇩1 e⇩1 «bop» e⇩2 :: T"
"P,E ⊢⇩1 new C :: T"
"P,E ⊢⇩1 e∙M(es) :: T"
"P,E ⊢⇩1 C∙⇩sM(es) :: T"
"P,E ⊢⇩1 [] [::] Ts"
"P,E ⊢⇩1 e#es [::] Ts"
lemma init_nWT⇩1 [simp]:"¬P,E ⊢⇩1 INIT C (Cs,b) ← e :: T"
by(auto elim:WT⇩1.cases)
lemma rinit_nWT⇩1 [simp]:"¬P,E ⊢⇩1 RI(C,e);Cs ← e' :: T"
by(auto elim:WT⇩1.cases)
lemma WTs⇩1_same_size: "⋀Ts. P,E ⊢⇩1 es [::] Ts ⟹ size es = size Ts"
by (induct es type:list) auto
lemma WT⇩1_unique:
"P,E ⊢⇩1 e :: T⇩1 ⟹ (⋀T⇩2. P,E ⊢⇩1 e :: T⇩2 ⟹ T⇩1 = T⇩2)" and
WTs⇩1_unique: "P,E ⊢⇩1 es [::] Ts⇩1 ⟹ (⋀Ts⇩2. P,E ⊢⇩1 es [::] Ts⇩2 ⟹ Ts⇩1 = Ts⇩2)"
apply(induct rule:WT⇩1_WTs⇩1.inducts)
apply blast
apply blast
apply clarsimp
apply blast
apply clarsimp
apply(case_tac bop)
apply clarsimp
apply clarsimp
apply blast
apply (blast dest:sees_field_idemp sees_field_fun)
apply (blast dest:sees_field_fun)
apply blast
apply (blast dest:sees_field_fun)
apply (blast dest:sees_method_idemp sees_method_fun)
apply (blast dest:sees_method_fun)
apply blast
apply blast
apply blast
apply blast
apply clarify
apply blast
apply blast
apply blast
done
lemma assumes wf: "wf_prog p P"
shows WT⇩1_is_type: "P,E ⊢⇩1 e :: T ⟹ set E ⊆ types P ⟹ is_type P T"
and "P,E ⊢⇩1 es [::] Ts ⟹ True"
apply(induct rule:WT⇩1_WTs⇩1.inducts)
apply simp
apply simp
apply (simp add:typeof_lit_is_type)
apply (blast intro:nth_mem)
apply(simp split:bop.splits)
apply simp
apply (simp add:sees_field_is_type[OF _ wf])
apply (simp add:sees_field_is_type[OF _ wf])
apply simp
apply simp
apply(fastforce dest!: sees_wf_mdecl[OF wf] simp:wf_mdecl_def)
apply(fastforce dest!: sees_wf_mdecl[OF wf] simp:wf_mdecl_def)
apply simp
apply simp
apply blast
apply simp
apply simp
apply simp
apply simp
apply simp
done
lemma WT⇩1_nsub_RI: "P,E ⊢⇩1 e :: T ⟹ ¬sub_RI e"
and WTs⇩1_nsub_RIs: "P,E ⊢⇩1 es [::] Ts ⟹ ¬sub_RIs es"
proof(induct rule: WT⇩1_WTs⇩1.inducts) qed(simp_all)
subsection‹ Runtime Well-Typedness ›
inductive
WTrt⇩1 :: "J⇩1_prog ⇒ heap ⇒ sheap ⇒ env⇩1 ⇒ expr⇩1 ⇒ ty ⇒ bool"
and WTrts⇩1 :: "J⇩1_prog ⇒ heap ⇒ sheap ⇒ env⇩1 ⇒ expr⇩1 list ⇒ ty list ⇒ bool"
and WTrt2⇩1 :: "[J⇩1_prog,env⇩1,heap,sheap,expr⇩1,ty] ⇒ bool"
("_,_,_,_ ⊢⇩1 _ : _" [51,51,51,51]50)
and WTrts2⇩1 :: "[J⇩1_prog,env⇩1,heap,sheap,expr⇩1 list, ty list] ⇒ bool"
("_,_,_,_ ⊢⇩1 _ [:] _" [51,51,51,51]50)
for P :: J⇩1_prog and h :: heap and sh :: sheap
where
"P,E,h,sh ⊢⇩1 e : T ≡ WTrt⇩1 P h sh E e T"
| "P,E,h,sh ⊢⇩1 es[:]Ts ≡ WTrts⇩1 P h sh E es Ts"
| WTrtNew⇩1:
"is_class P C ⟹
P,E,h,sh ⊢⇩1 new C : Class C"
| WTrtCast⇩1:
"⟦ P,E,h,sh ⊢⇩1 e : T; is_refT T; is_class P C ⟧
⟹ P,E,h,sh ⊢⇩1 Cast C e : Class C"
| WTrtVal⇩1:
"typeof⇘h⇙ v = Some T ⟹
P,E,h,sh ⊢⇩1 Val v : T"
| WTrtVar⇩1:
"⟦ E!i = T; i < size E ⟧ ⟹
P,E,h,sh ⊢⇩1 Var i : T"
| WTrtBinOpEq⇩1:
"⟦ P,E,h,sh ⊢⇩1 e⇩1 : T⇩1; P,E,h,sh ⊢⇩1 e⇩2 : T⇩2 ⟧
⟹ P,E,h,sh ⊢⇩1 e⇩1 «Eq» e⇩2 : Boolean"
| WTrtBinOpAdd⇩1:
"⟦ P,E,h,sh ⊢⇩1 e⇩1 : Integer; P,E,h,sh ⊢⇩1 e⇩2 : Integer ⟧
⟹ P,E,h,sh ⊢⇩1 e⇩1 «Add» e⇩2 : Integer"
| WTrtLAss⇩1:
"⟦ E!i = T; i < size E; P,E,h,sh ⊢⇩1 e : T'; P ⊢ T' ≤ T ⟧
⟹ P,E,h,sh ⊢⇩1 i:=e : Void"
| WTrtFAcc⇩1:
"⟦ P,E,h,sh ⊢⇩1 e : Class C; P ⊢ C has F,NonStatic:T in D ⟧ ⟹
P,E,h,sh ⊢⇩1 e∙F{D} : T"
| WTrtFAccNT⇩1:
"P,E,h,sh ⊢⇩1 e : NT ⟹
P,E,h,sh ⊢⇩1 e∙F{D} : T"
| WTrtSFAcc⇩1:
"⟦ P ⊢ C has F,Static:T in D ⟧ ⟹
P,E,h,sh ⊢⇩1 C∙⇩sF{D} : T"
| WTrtFAss⇩1:
"⟦ P,E,h,sh ⊢⇩1 e⇩1 : Class C; P ⊢ C has F,NonStatic:T in D; P,E,h,sh ⊢⇩1 e⇩2 : T⇩2; P ⊢ T⇩2 ≤ T ⟧
⟹ P,E,h,sh ⊢⇩1 e⇩1∙F{D}:=e⇩2 : Void"
| WTrtFAssNT⇩1:
"⟦ P,E,h,sh ⊢⇩1 e⇩1:NT; P,E,h,sh ⊢⇩1 e⇩2 : T⇩2 ⟧
⟹ P,E,h,sh ⊢⇩1 e⇩1∙F{D}:=e⇩2 : Void"
| WTrtSFAss⇩1:
"⟦ P,E,h,sh ⊢⇩1 e⇩2 : T⇩2; P ⊢ C has F,Static:T in D; P ⊢ T⇩2 ≤ T ⟧
⟹ P,E,h,sh ⊢⇩1 C∙⇩sF{D}:=e⇩2 : Void"
| WTrtCall⇩1:
"⟦ P,E,h,sh ⊢⇩1 e : Class C; P ⊢ C sees M,NonStatic:Ts → T = m in D;
P,E,h,sh ⊢⇩1 es [:] Ts'; P ⊢ Ts' [≤] Ts ⟧
⟹ P,E,h,sh ⊢⇩1 e∙M(es) : T"
| WTrtCallNT⇩1:
"⟦ P,E,h,sh ⊢⇩1 e : NT; P,E,h,sh ⊢⇩1 es [:] Ts ⟧
⟹ P,E,h,sh ⊢⇩1 e∙M(es) : T"
| WTrtSCall⇩1:
"⟦ P ⊢ C sees M,Static:Ts → T = m in D;
P,E,h,sh ⊢⇩1 es [:] Ts'; P ⊢ Ts' [≤] Ts;
M = clinit ⟶ sh D = ⌊(sfs,Processing)⌋ ∧ es = map Val vs ⟧
⟹ P,E,h,sh ⊢⇩1 C∙⇩sM(es) : T"
| WTrtBlock⇩1:
"P,E@[T],h,sh ⊢⇩1 e : T' ⟹
P,E,h,sh ⊢⇩1 {i:T; e} : T'"
| WTrtSeq⇩1:
"⟦ P,E,h,sh ⊢⇩1 e⇩1:T⇩1; P,E,h,sh ⊢⇩1 e⇩2:T⇩2 ⟧
⟹ P,E,h,sh ⊢⇩1 e⇩1;;e⇩2 : T⇩2"
| WTrtCond⇩1:
"⟦ P,E,h,sh ⊢⇩1 e : Boolean; P,E,h,sh ⊢⇩1 e⇩1:T⇩1; P,E,h,sh ⊢⇩1 e⇩2:T⇩2;
P ⊢ T⇩1 ≤ T⇩2 ∨ P ⊢ T⇩2 ≤ T⇩1; P ⊢ T⇩1 ≤ T⇩2 ⟶ T = T⇩2; P ⊢ T⇩2 ≤ T⇩1 ⟶ T = T⇩1 ⟧
⟹ P,E,h,sh ⊢⇩1 if (e) e⇩1 else e⇩2 : T"
| WTrtWhile⇩1:
"⟦ P,E,h,sh ⊢⇩1 e : Boolean; P,E,h,sh ⊢⇩1 c:T ⟧
⟹ P,E,h,sh ⊢⇩1 while(e) c : Void"
| WTrtThrow⇩1:
"⟦ P,E,h,sh ⊢⇩1 e : T⇩r; is_refT T⇩r ⟧ ⟹
P,E,h,sh ⊢⇩1 throw e : T"
| WTrtTry⇩1:
"⟦ P,E,h,sh ⊢⇩1 e⇩1 : T⇩1; P,E@[Class C],h,sh ⊢⇩1 e⇩2 : T⇩2; P ⊢ T⇩1 ≤ T⇩2 ⟧
⟹ P,E,h,sh ⊢⇩1 try e⇩1 catch(C i) e⇩2 : T⇩2"
| WTrtInit⇩1:
"⟦ P,E,h,sh ⊢⇩1 e : T; ∀C' ∈ set (C#Cs). is_class P C'; ¬sub_RI e;
∀C' ∈ set (tl Cs). ∃sfs. sh C' = ⌊(sfs,Processing)⌋;
b ⟶ (∀C' ∈ set Cs. ∃sfs. sh C' = ⌊(sfs,Processing)⌋);
distinct Cs; supercls_lst P Cs ⟧
⟹ P,E,h,sh ⊢⇩1 INIT C (Cs, b) ← e : T"
| WTrtRI⇩1:
"⟦ P,E,h,sh ⊢⇩1 e : T; P,E,h,sh ⊢⇩1 e' : T'; ∀C' ∈ set (C#Cs). is_class P C'; ¬sub_RI e';
∀C' ∈ set (C#Cs). not_init C' e;
∀C' ∈ set Cs. ∃sfs. sh C' = ⌊(sfs,Processing)⌋;
∃sfs. sh C = ⌊(sfs, Processing)⌋ ∨ (sh C = ⌊(sfs, Error)⌋ ∧ e = THROW NoClassDefFoundError);
distinct (C#Cs); supercls_lst P (C#Cs) ⟧
⟹ P,E,h,sh ⊢⇩1 RI(C, e);Cs ← e' : T'"
| WTrtNil⇩1:
"P,E,h,sh ⊢⇩1 [] [:] []"
| WTrtCons⇩1:
"⟦ P,E,h,sh ⊢⇩1 e : T; P,E,h,sh ⊢⇩1 es [:] Ts ⟧
⟹ P,E,h,sh ⊢⇩1 e#es [:] T#Ts"
declare WTrt⇩1_WTrts⇩1.intros[intro!] WTrtNil⇩1[iff]
declare
WTrtFAcc⇩1[rule del] WTrtFAccNT⇩1[rule del] WTrtSFAcc⇩1[rule del]
WTrtFAss⇩1[rule del] WTrtFAssNT⇩1[rule del] WTrtSFAss⇩1[rule del]
WTrtCall⇩1[rule del] WTrtCallNT⇩1[rule del] WTrtSCall⇩1[rule del]
lemmas WTrt⇩1_induct = WTrt⇩1_WTrts⇩1.induct [split_format (complete)]
and WTrt⇩1_inducts = WTrt⇩1_WTrts⇩1.inducts [split_format (complete)]
inductive_cases WTrt⇩1_elim_cases[elim!]:
"P,E,h,sh ⊢⇩1 Val v : T"
"P,E,h,sh ⊢⇩1 Var i : T"
"P,E,h,sh ⊢⇩1 v :=e : T"
"P,E,h,sh ⊢⇩1 {i:U; e} : T"
"P,E,h,sh ⊢⇩1 e⇩1;;e⇩2 : T⇩2"
"P,E,h,sh ⊢⇩1 if (e) e⇩1 else e⇩2 : T"
"P,E,h,sh ⊢⇩1 while(e) c : T"
"P,E,h,sh ⊢⇩1 throw e : T"
"P,E,h,sh ⊢⇩1 try e⇩1 catch(C V) e⇩2 : T"
"P,E,h,sh ⊢⇩1 Cast D e : T"
"P,E,h,sh ⊢⇩1 e∙F{D} : T"
"P,E,h,sh ⊢⇩1 C∙⇩sF{D} : T"
"P,E,h,sh ⊢⇩1 e∙F{D} := v : T"
"P,E,h,sh ⊢⇩1 C∙⇩sF{D} := v : T"
"P,E,h,sh ⊢⇩1 e⇩1 «bop» e⇩2 : T"
"P,E,h,sh ⊢⇩1 new C : T"
"P,E,h,sh ⊢⇩1 e∙M{D}(es) : T"
"P,E,h,sh ⊢⇩1 C∙⇩sM{D}(es) : T"
"P,E,h,sh ⊢⇩1 INIT C (Cs,b) ← e : T"
"P,E,h,sh ⊢⇩1 RI(C,e);Cs ← e' : T"
"P,E,h,sh ⊢⇩1 [] [:] Ts"
"P,E,h,sh ⊢⇩1 e#es [:] Ts"
lemma WT⇩1_implies_WTrt⇩1: "P,E ⊢⇩1 e :: T ⟹ P,E,h,sh ⊢⇩1 e : T"
and WTs⇩1_implies_WTrts⇩1: "P,E ⊢⇩1 es [::] Ts ⟹ P,E,h,sh ⊢⇩1 es [:] Ts"
apply(induct rule: WT⇩1_WTs⇩1_inducts)
apply fast
apply (fast)
apply(fastforce dest:typeof_lit_typeof)
apply(fast)
apply(rename_tac E e⇩1 T⇩1 e⇩2 T⇩2 bop T) apply(case_tac bop)
apply(fastforce)
apply(fastforce)
apply(fastforce)
apply(meson WTrtFAcc⇩1 has_visible_field)
apply(meson WTrtSFAcc⇩1 has_visible_field)
apply(meson WTrtFAss⇩1 has_visible_field)
apply(meson WTrtSFAss⇩1 has_visible_field)
apply(fastforce simp: WTrtCall⇩1)
apply(fastforce simp: WTrtSCall⇩1)
apply(fastforce)
apply(fastforce)
apply(fastforce simp: WTrtCond⇩1)
apply(fastforce)
apply(fastforce)
apply(fastforce)
apply(simp)
apply(fast)
done
subsection‹ Well-formedness›
primrec ℬ :: "expr⇩1 ⇒ nat ⇒ bool"
and ℬs :: "expr⇩1 list ⇒ nat ⇒ bool" where
"ℬ (new C) i = True" |
"ℬ (Cast C e) i = ℬ e i" |
"ℬ (Val v) i = True" |
"ℬ (e⇩1 «bop» e⇩2) i = (ℬ e⇩1 i ∧ ℬ e⇩2 i)" |
"ℬ (Var j) i = True" |
"ℬ (e∙F{D}) i = ℬ e i" |
"ℬ (C∙⇩sF{D}) i = True" |
"ℬ (j:=e) i = ℬ e i" |
"ℬ (e⇩1∙F{D} := e⇩2) i = (ℬ e⇩1 i ∧ ℬ e⇩2 i)" |
"ℬ (C∙⇩sF{D} := e⇩2) i = ℬ e⇩2 i" |
"ℬ (e∙M(es)) i = (ℬ e i ∧ ℬs es i)" |
"ℬ (C∙⇩sM(es)) i = ℬs es i" |
"ℬ ({j:T ; e}) i = (i = j ∧ ℬ e (i+1))" |
"ℬ (e⇩1;;e⇩2) i = (ℬ e⇩1 i ∧ ℬ e⇩2 i)" |
"ℬ (if (e) e⇩1 else e⇩2) i = (ℬ e i ∧ ℬ e⇩1 i ∧ ℬ e⇩2 i)" |
"ℬ (throw e) i = ℬ e i" |
"ℬ (while (e) c) i = (ℬ e i ∧ ℬ c i)" |
"ℬ (try e⇩1 catch(C j) e⇩2) i = (ℬ e⇩1 i ∧ i=j ∧ ℬ e⇩2 (i+1))" |
"ℬ (INIT C (Cs,b) ← e) i = ℬ e i" |
"ℬ (RI(C,e);Cs ← e') i = (ℬ e i ∧ ℬ e' i)" |
"ℬs [] i = True" |
"ℬs (e#es) i = (ℬ e i ∧ ℬs es i)"
definition wf_J⇩1_mdecl :: "J⇩1_prog ⇒ cname ⇒ expr⇩1 mdecl ⇒ bool"
where
"wf_J⇩1_mdecl P C ≡ λ(M,b,Ts,T,body).
¬sub_RI body ∧
(case b of
NonStatic ⇒
(∃T'. P,Class C#Ts ⊢⇩1 body :: T' ∧ P ⊢ T' ≤ T) ∧
𝒟 body ⌊{..size Ts}⌋ ∧ ℬ body (size Ts + 1)
| Static ⇒ (∃T'. P,Ts ⊢⇩1 body :: T' ∧ P ⊢ T' ≤ T) ∧
𝒟 body ⌊{..<size Ts}⌋ ∧ ℬ body (size Ts))"
lemma wf_J⇩1_mdecl_NonStatic[simp]:
"wf_J⇩1_mdecl P C (M,NonStatic,Ts,T,body) ≡
(¬sub_RI body ∧
(∃T'. P,Class C#Ts ⊢⇩1 body :: T' ∧ P ⊢ T' ≤ T) ∧
𝒟 body ⌊{..size Ts}⌋ ∧ ℬ body (size Ts + 1))"
by (simp add:wf_J⇩1_mdecl_def)
lemma wf_J⇩1_mdecl_Static[simp]:
"wf_J⇩1_mdecl P C (M,Static,Ts,T,body) ≡
(¬sub_RI body ∧
(∃T'. P,Ts ⊢⇩1 body :: T' ∧ P ⊢ T' ≤ T) ∧
𝒟 body ⌊{..<size Ts}⌋ ∧ ℬ body (size Ts))"
by (simp add:wf_J⇩1_mdecl_def)
abbreviation "wf_J⇩1_prog == wf_prog wf_J⇩1_mdecl"
lemma sees_wf⇩1_nsub_RI:
"⟦ wf_J⇩1_prog P; P ⊢ C sees M,b : Ts→T = body in D ⟧ ⟹ ¬sub_RI body"
apply(drule sees_wf_mdecl, simp)
apply(unfold wf_J⇩1_mdecl_def wf_mdecl_def, simp)
done
lemma wf⇩1_types_clinit:
assumes wf:"wf_prog wf_md P" and ex: "class P C = Some a" and proc: "sh C = ⌊(sfs, Processing)⌋"
shows "P,E,h,sh ⊢⇩1 C∙⇩sclinit([]) : Void"
proof -
from ex obtain D fs ms where "a = (D,fs,ms)" by(cases a)
then have sP: "(C, D, fs, ms) ∈ set P" using ex map_of_SomeD[of P C a] by(simp add: class_def)
then have "wf_clinit ms" using assms by(unfold wf_prog_def wf_cdecl_def, auto)
then obtain m where sm: "(clinit, Static, [], Void, m) ∈ set ms"
by(unfold wf_clinit_def) auto
then have "P ⊢ C sees clinit,Static:[] → Void = m in C"
using mdecl_visible[OF wf sP sm] by simp
then show ?thesis using WTrtSCall⇩1 proc by blast
qed
lemma assumes wf: "wf_J⇩1_prog P"
shows eval⇩1_proc_pres: "P ⊢⇩1 ⟨e,(h,l,sh)⟩ ⇒ ⟨e',(h',l',sh')⟩
⟹ not_init C e ⟹ ∃sfs. sh C = ⌊(sfs, Processing)⌋ ⟹ ∃sfs'. sh' C = ⌊(sfs', Processing)⌋"
and evals⇩1_proc_pres: "P ⊢⇩1 ⟨es,(h,l,sh)⟩ [⇒] ⟨es',(h',l',sh')⟩
⟹ not_inits C es ⟹ ∃sfs. sh C = ⌊(sfs, Processing)⌋ ⟹ ∃sfs'. sh' C = ⌊(sfs', Processing)⌋"
proof(induct rule:eval⇩1_evals⇩1_inducts)
case Call⇩1 then show ?case using sees_wf⇩1_nsub_RI[OF wf Call⇩1.hyps(6)] nsub_RI_not_init by auto
next
case (SCallInit⇩1 ps h l sh vs h⇩1 l⇩1 sh⇩1 C' M Ts T body D v' h⇩2 l⇩2 sh⇩2 l⇩2' e' h⇩3 l⇩3 sh⇩3)
then show ?case
using SCallInit⇩1 sees_wf⇩1_nsub_RI[OF wf SCallInit⇩1.hyps(3)] nsub_RI_not_init[of body] by auto
next
case SCall⇩1 then show ?case using sees_wf⇩1_nsub_RI[OF wf SCall⇩1.hyps(3)] nsub_RI_not_init by auto
next
case (InitNone⇩1 sh C1 C' Cs h l e' a a b) then show ?case by(cases "C = C1") auto
next
case (InitDone⇩1 sh C sfs C' Cs h l e' a a b) then show ?case by(cases Cs, auto)
next
case (InitProcessing⇩1 sh C sfs C' Cs h l e' a a b) then show ?case by(cases Cs, auto)
next
case (InitError⇩1 sh C1 sfs Cs h l e' a a b C') then show ?case by(cases "C = C1") auto
next
case (InitObject⇩1 sh C1 sfs sh' C' Cs h l e' a a b) then show ?case by(cases "C = C1") auto
next
case (InitNonObject⇩1 sh C1 sfs D a b sh' C' Cs h l e' a a b)
then show ?case by(cases "C = C1") auto
next
case (RInit⇩1 e a a b v h' l' sh' C sfs i sh'' C' Cs e⇩1 a a b) then show ?case by(cases Cs, auto)
next
case (RInitInitFail⇩1 e h l sh a h' l' sh' C1 sfs i sh'' D Cs e⇩1 h1 l1 sh1)
then show ?case using eval⇩1_final by fastforce
qed(auto)
lemma clinit⇩1_proc_pres:
"⟦ wf_J⇩1_prog P; P ⊢⇩1 ⟨C⇩0∙⇩sclinit([]),(h,l,sh)⟩ ⇒ ⟨e',(h',l',sh')⟩;
sh C' = ⌊(sfs,Processing)⌋ ⟧
⟹ ∃sfs. sh' C' = ⌊(sfs,Processing)⌋"
by(auto dest: eval⇩1_proc_pres)
end
Theory PCompiler
section ‹ Program Compilation ›
theory PCompiler
imports "../Common/WellForm"
begin
definition compM :: "(staticb ⇒ 'a ⇒ 'b) ⇒ 'a mdecl ⇒ 'b mdecl"
where
"compM f ≡ λ(M, b, Ts, T, m). (M, b, Ts, T, f b m)"
definition compC :: "(staticb ⇒ 'a ⇒ 'b) ⇒ 'a cdecl ⇒ 'b cdecl"
where
"compC f ≡ λ(C,D,Fdecls,Mdecls). (C,D,Fdecls, map (compM f) Mdecls)"
definition compP :: "(staticb ⇒ 'a ⇒ 'b) ⇒ 'a prog ⇒ 'b prog"
where
"compP f ≡ map (compC f)"
text‹ Compilation preserves the program structure. Therefore lookup
functions either commute with compilation (like method lookup) or are
preserved by it (like the subclass relation). ›
lemma map_of_map4:
"map_of (map (λ(x,a,b,c).(x,a,b,f c)) ts) =
map_option (λ(a,b,c).(a,b,f c)) ∘ (map_of ts)"
apply(induct ts)
apply simp
apply(rule ext)
apply fastforce
done
lemma map_of_map245:
"map_of (map (λ(x,a,b,c,d).(x,a,b,c,f a c d)) ts) =
map_option (λ(a,b,c,d).(a,b,c,f a c d)) ∘ (map_of ts)"
apply(induct ts)
apply simp
apply(rule ext)
apply fastforce
done
lemma class_compP:
"class P C = Some (D, fs, ms)
⟹ class (compP f P) C = Some (D, fs, map (compM f) ms)"
by(simp add:class_def compP_def compC_def map_of_map4)
lemma class_compPD:
"class (compP f P) C = Some (D, fs, cms)
⟹ ∃ms. class P C = Some(D,fs,ms) ∧ cms = map (compM f) ms"
by(clarsimp simp add:class_def compP_def compC_def map_of_map4)
lemma [simp]: "is_class (compP f P) C = is_class P C"
by(auto simp:is_class_def dest: class_compP class_compPD)
lemma [simp]: "class (compP f P) C = map_option (λc. snd(compC f (C,c))) (class P C)"
apply(simp add:compP_def compC_def class_def map_of_map4)
apply(simp add:split_def)
done
lemma sees_methods_compP:
"P ⊢ C sees_methods Mm ⟹
compP f P ⊢ C sees_methods (map_option (λ((b,Ts,T,m),D). ((b,Ts,T,f b m),D)) ∘ Mm)"
apply(erule Methods.induct)
apply(rule sees_methods_Object)
apply(erule class_compP)
apply(rule ext)
apply(simp add:compM_def map_of_map245 option.map_comp)
apply(case_tac "map_of ms x")
apply simp
apply fastforce
apply(rule sees_methods_rec)
apply(erule class_compP)
apply assumption
apply assumption
apply(rule ext)
apply(simp add:map_add_def compM_def map_of_map245 option.map_comp split:option.split)
done
lemma sees_method_compP:
"P ⊢ C sees M,b: Ts→T = m in D ⟹
compP f P ⊢ C sees M,b: Ts→T = (f b m) in D"
by(fastforce elim:sees_methods_compP simp add:Method_def)
lemma [simp]:
"P ⊢ C sees M,b: Ts→T = m in D ⟹
method (compP f P) C M = (D,b,Ts,T,f b m)"
apply(drule sees_method_compP)
apply(simp add:method_def)
apply(rule the_equality)
apply simp
apply(fastforce dest:sees_method_fun)
done
lemma sees_methods_compPD:
"⟦ cP ⊢ C sees_methods Mm'; cP = compP f P ⟧ ⟹
∃Mm. P ⊢ C sees_methods Mm ∧
Mm' = (map_option (λ((b,Ts,T,m),D). ((b,Ts,T,f b m),D)) ∘ Mm)"
apply(erule Methods.induct)
apply(clarsimp simp:compC_def)
apply(rule exI)
apply(rule conjI, erule sees_methods_Object)
apply(rule refl)
apply(rule ext)
apply(simp add:compM_def map_of_map245 option.map_comp)
apply(case_tac "map_of b x")
apply simp
apply fastforce
apply(clarsimp simp:compC_def)
apply(rule exI, rule conjI)
apply(erule (2) sees_methods_rec)
apply(rule refl)
apply(rule ext)
apply(simp add:map_add_def compM_def map_of_map245 option.map_comp split:option.split)
done
lemma sees_method_compPD:
"compP f P ⊢ C sees M,b: Ts→T = fm in D ⟹
∃m. P ⊢ C sees M,b: Ts→T = m in D ∧ f b m = fm"
apply(simp add:Method_def)
apply clarify
apply(drule sees_methods_compPD[OF _ refl])
apply clarsimp
apply blast
done
lemma [simp]: "subcls1(compP f P) = subcls1 P"
by(fastforce simp add: is_class_def compC_def intro:subcls1I order_antisym dest:subcls1D)
lemma compP_widen[simp]: "(compP f P ⊢ T ≤ T') = (P ⊢ T ≤ T')"
by(cases T')(simp_all add:widen_Class)
lemma [simp]: "(compP f P ⊢ Ts [≤] Ts') = (P ⊢ Ts [≤] Ts')"
apply(induct Ts)
apply simp
apply(cases Ts')
apply(auto simp:fun_of_def)
done
lemma [simp]: "is_type (compP f P) T = is_type P T"
by(cases T) simp_all
lemma [simp]: "(compP (f::staticb⇒'a⇒'b) P ⊢ C has_fields FDTs) = (P ⊢ C has_fields FDTs)"
(is "?A = ?B")
proof
{ fix cP::"'b prog" assume "cP ⊢ C has_fields FDTs"
hence "cP = compP f P ⟹ P ⊢ C has_fields FDTs"
proof induct
case has_fields_Object
thus ?case by(fast intro:Fields.has_fields_Object dest:class_compPD)
next
case has_fields_rec
thus ?case by(fast intro:Fields.has_fields_rec dest:class_compPD)
qed
} note lem = this
assume ?A
with lem show ?B by blast
next
assume ?B
thus ?A
proof induct
case has_fields_Object
thus ?case by(fast intro:Fields.has_fields_Object class_compP)
next
case has_fields_rec
thus ?case by(fast intro:Fields.has_fields_rec class_compP)
qed
qed
lemma fields_compP [simp]: "fields (compP f P) C = fields P C"
by(simp add:fields_def)
lemma ifields_compP [simp]: "ifields (compP f P) C = ifields P C"
by(simp add:ifields_def)
lemma blank_compP [simp]: "blank (compP f P) C = blank P C"
by(simp add:blank_def)
lemma isfields_compP [simp]: "isfields (compP f P) C = isfields P C"
by(simp add:isfields_def)
lemma sblank_compP [simp]: "sblank (compP f P) C = sblank P C"
by(simp add:sblank_def)
lemma sees_fields_compP [simp]: "(compP f P ⊢ C sees F,b:T in D) = (P ⊢ C sees F,b:T in D)"
by(simp add:sees_field_def)
lemma has_field_compP [simp]: "(compP f P ⊢ C has F,b:T in D) = (P ⊢ C has F,b:T in D)"
by(simp add:has_field_def)
lemma field_compP [simp]: "field (compP f P) F D = field P F D"
by(simp add:field_def)
subsection‹Invariance of @{term wf_prog} under compilation ›
lemma [iff]: "distinct_fst (compP f P) = distinct_fst P"
apply(simp add:distinct_fst_def compP_def compC_def)
apply(induct P)
apply (auto simp:image_iff)
done
lemma [iff]: "distinct_fst (map (compM f) ms) = distinct_fst ms"
apply(simp add:distinct_fst_def compM_def)
apply(induct ms)
apply (auto simp:image_iff)
done
lemma [iff]: "wf_syscls (compP f P) = wf_syscls P"
by(simp add:wf_syscls_def compP_def compC_def image_def Bex_def)
lemma [iff]: "wf_fdecl (compP f P) = wf_fdecl P"
by(simp add:wf_fdecl_def)
lemma wf_clinit_compM [iff]: "wf_clinit (map (compM f) ms) = wf_clinit ms"
apply(simp add: wf_clinit_def compM_def)
apply(rule iffI)
apply clarsimp apply(rename_tac m)
apply(rule_tac x = m in exI, simp+)
apply clarsimp apply(rename_tac m)
apply(rule_tac x = "f Static m" in exI, simp add: rev_image_eqI)
done
lemma set_compP:
"((C,D,fs,ms') ∈ set(compP f P)) =
(∃ms. (C,D,fs,ms) ∈ set P ∧ ms' = map (compM f) ms)"
by(fastforce simp add:compP_def compC_def image_iff Bex_def)
lemma wf_cdecl_compPI:
"⟦ ⋀C M b Ts T m.
⟦ wf_mdecl wf⇩1 P C (M,b,Ts,T,m); P ⊢ C sees M,b:Ts→T = m in C ⟧
⟹ wf_mdecl wf⇩2 (compP f P) C (M,b,Ts,T, f b m);
∀x∈set P. wf_cdecl wf⇩1 P x; x ∈ set (compP f P); wf_prog p P ⟧
⟹ wf_cdecl wf⇩2 (compP f P) x"
apply(clarsimp simp add:wf_cdecl_def Ball_def set_compP)
apply(rename_tac C D fs ms)
apply(rule conjI)
apply (clarsimp simp:compM_def)
apply (drule (2) mdecl_visible)
apply simp
apply(clarify)
apply(drule sees_method_compPD[where f = f])
apply clarsimp
apply(fastforce simp:image_iff compM_def)
done
lemma wf_prog_compPI:
assumes lift:
"⋀C M b Ts T m.
⟦ P ⊢ C sees M,b:Ts→T = m in C; wf_mdecl wf⇩1 P C (M,b,Ts,T,m) ⟧
⟹ wf_mdecl wf⇩2 (compP f P) C (M,b,Ts,T, f b m)"
and wf: "wf_prog wf⇩1 P"
shows "wf_prog wf⇩2 (compP f P)"
using wf
by (simp add:wf_prog_def) (blast intro:wf_cdecl_compPI lift wf)
end
Theory Hidden
theory Hidden
imports "List-Index.List_Index"
begin
definition hidden :: "'a list ⇒ nat ⇒ bool" where
"hidden xs i ≡ i < size xs ∧ xs!i ∈ set(drop (i+1) xs)"
lemma hidden_last_index: "x ∈ set xs ⟹ hidden (xs @ [x]) (last_index xs x)"
apply(auto simp add: hidden_def nth_append rev_nth[symmetric])
apply(drule last_index_less[OF _ le_refl])
apply simp
done
lemma hidden_inacc: "hidden xs i ⟹ last_index xs x ≠ i"
by(auto simp add: hidden_def last_index_drop last_index_less_size_conv)
lemma [simp]: "hidden xs i ⟹ hidden (xs@[x]) i"
by(auto simp add:hidden_def nth_append)
lemma fun_upds_apply:
"(m(xs[↦]ys)) x =
(let xs' = take (size ys) xs
in if x ∈ set xs' then Some(ys ! last_index xs' x) else m x)"
apply(induct xs arbitrary: m ys)
apply (simp add: Let_def)
apply(case_tac ys)
apply (simp add:Let_def)
apply (simp add: Let_def last_index_Cons)
done
lemma map_upds_apply_eq_Some:
"((m(xs[↦]ys)) x = Some y) =
(let xs' = take (size ys) xs
in if x ∈ set xs' then ys ! last_index xs' x = y else m x = Some y)"
by(simp add:fun_upds_apply Let_def)
lemma map_upds_upd_conv_last_index:
"⟦x ∈ set xs; size xs ≤ size ys ⟧
⟹ m(xs[↦]ys)(x↦y) = m(xs[↦]ys[last_index xs x := y])"
apply(rule ext)
apply(simp add:fun_upds_apply eq_sym_conv Let_def)
done
end
Theory Compiler1
section ‹ Compilation Stage 1 ›
theory Compiler1 imports PCompiler J1 Hidden begin
text‹ Replacing variable names by indices. ›
primrec compE⇩1 :: "vname list ⇒ expr ⇒ expr⇩1"
and compEs⇩1 :: "vname list ⇒ expr list ⇒ expr⇩1 list" where
"compE⇩1 Vs (new C) = new C"
| "compE⇩1 Vs (Cast C e) = Cast C (compE⇩1 Vs e)"
| "compE⇩1 Vs (Val v) = Val v"
| "compE⇩1 Vs (e⇩1 «bop» e⇩2) = (compE⇩1 Vs e⇩1) «bop» (compE⇩1 Vs e⇩2)"
| "compE⇩1 Vs (Var V) = Var(last_index Vs V)"
| "compE⇩1 Vs (V:=e) = (last_index Vs V):= (compE⇩1 Vs e)"
| "compE⇩1 Vs (e∙F{D}) = (compE⇩1 Vs e)∙F{D}"
| "compE⇩1 Vs (C∙⇩sF{D}) = C∙⇩sF{D}"
| "compE⇩1 Vs (e⇩1∙F{D}:=e⇩2) = (compE⇩1 Vs e⇩1)∙F{D} := (compE⇩1 Vs e⇩2)"
| "compE⇩1 Vs (C∙⇩sF{D}:=e⇩2) = C∙⇩sF{D} := (compE⇩1 Vs e⇩2)"
| "compE⇩1 Vs (e∙M(es)) = (compE⇩1 Vs e)∙M(compEs⇩1 Vs es)"
| "compE⇩1 Vs (C∙⇩sM(es)) = C∙⇩sM(compEs⇩1 Vs es)"
| "compE⇩1 Vs {V:T; e} = {(size Vs):T; compE⇩1 (Vs@[V]) e}"
| "compE⇩1 Vs (e⇩1;;e⇩2) = (compE⇩1 Vs e⇩1);;(compE⇩1 Vs e⇩2)"
| "compE⇩1 Vs (if (e) e⇩1 else e⇩2) = if (compE⇩1 Vs e) (compE⇩1 Vs e⇩1) else (compE⇩1 Vs e⇩2)"
| "compE⇩1 Vs (while (e) c) = while (compE⇩1 Vs e) (compE⇩1 Vs c)"
| "compE⇩1 Vs (throw e) = throw (compE⇩1 Vs e)"
| "compE⇩1 Vs (try e⇩1 catch(C V) e⇩2) =
try(compE⇩1 Vs e⇩1) catch(C (size Vs)) (compE⇩1 (Vs@[V]) e⇩2)"
| "compE⇩1 Vs (INIT C (Cs,b) ← e) = INIT C (Cs,b) ← (compE⇩1 Vs e)"
| "compE⇩1 Vs (RI(C,e);Cs ← e') = RI(C,(compE⇩1 Vs e));Cs ← (compE⇩1 Vs e')"
| "compEs⇩1 Vs [] = []"
| "compEs⇩1 Vs (e#es) = compE⇩1 Vs e # compEs⇩1 Vs es"
lemma [simp]: "compEs⇩1 Vs es = map (compE⇩1 Vs) es"
by(induct es type:list) simp_all
lemma [simp]: "⋀Vs. sub_RI (compE⇩1 Vs e) = sub_RI e"
and [simp]: "⋀Vs. sub_RIs (compEs⇩1 Vs es) = sub_RIs es"
proof(induct rule: sub_RI_sub_RIs_induct) qed(auto)
primrec fin⇩1:: "expr ⇒ expr⇩1" where
"fin⇩1(Val v) = Val v"
| "fin⇩1(throw e) = throw(fin⇩1 e)"
lemma comp_final: "final e ⟹ compE⇩1 Vs e = fin⇩1 e"
by(erule finalE, simp_all)
lemma [simp]:
"⋀Vs. max_vars (compE⇩1 Vs e) = max_vars e"
and "⋀Vs. max_varss (compEs⇩1 Vs es) = max_varss es"
by (induct e and es rule: max_vars.induct max_varss.induct) simp_all
text‹ Compiling programs: ›
definition compP⇩1 :: "J_prog ⇒ J⇩1_prog"
where
"compP⇩1 ≡ compP (λb (pns,body). compE⇩1 (case b of NonStatic ⇒ this#pns | Static ⇒ pns) body)"
declare compP⇩1_def[simp]
end
Theory Correctness1
section ‹ Correctness of Stage 1 ›
theory Correctness1
imports J1WellForm Compiler1
begin
subsection‹Correctness of program compilation ›
primrec unmod :: "expr⇩1 ⇒ nat ⇒ bool"
and unmods :: "expr⇩1 list ⇒ nat ⇒ bool" where
"unmod (new C) i = True" |
"unmod (Cast C e) i = unmod e i" |
"unmod (Val v) i = True" |
"unmod (e⇩1 «bop» e⇩2) i = (unmod e⇩1 i ∧ unmod e⇩2 i)" |
"unmod (Var i) j = True" |
"unmod (i:=e) j = (i ≠ j ∧ unmod e j)" |
"unmod (e∙F{D}) i = unmod e i" |
"unmod (C∙⇩sF{D}) i = True" |
"unmod (e⇩1∙F{D}:=e⇩2) i = (unmod e⇩1 i ∧ unmod e⇩2 i)" |
"unmod (C∙⇩sF{D}:=e⇩2) i = unmod e⇩2 i" |
"unmod (e∙M(es)) i = (unmod e i ∧ unmods es i)" |
"unmod (C∙⇩sM(es)) i = unmods es i" |
"unmod {j:T; e} i = unmod e i" |
"unmod (e⇩1;;e⇩2) i = (unmod e⇩1 i ∧ unmod e⇩2 i)" |
"unmod (if (e) e⇩1 else e⇩2) i = (unmod e i ∧ unmod e⇩1 i ∧ unmod e⇩2 i)" |
"unmod (while (e) c) i = (unmod e i ∧ unmod c i)" |
"unmod (throw e) i = unmod e i" |
"unmod (try e⇩1 catch(C i) e⇩2) j = (unmod e⇩1 j ∧ (if i=j then False else unmod e⇩2 j))" |
"unmod (INIT C (Cs,b) ← e) i = unmod e i" |
"unmod (RI(C,e);Cs ← e') i = (unmod e i ∧ unmod e' i)" |
"unmods ([]) i = True" |
"unmods (e#es) i = (unmod e i ∧ unmods es i)"
lemma hidden_unmod: "⋀Vs. hidden Vs i ⟹ unmod (compE⇩1 Vs e) i" and
"⋀Vs. hidden Vs i ⟹ unmods (compEs⇩1 Vs es) i"
apply(induct e and es rule: compE⇩1.induct compEs⇩1.induct)
apply (simp_all add:hidden_inacc)
apply(auto simp add:hidden_def)
done
lemma eval⇩1_preserves_unmod:
"⟦ P ⊢⇩1 ⟨e,(h,ls,sh)⟩ ⇒ ⟨e',(h',ls',sh')⟩; unmod e i; i < size ls ⟧
⟹ ls ! i = ls' ! i"
and "⟦ P ⊢⇩1 ⟨es,(h,ls,sh)⟩ [⇒] ⟨es',(h',ls',sh')⟩; unmods es i; i < size ls ⟧
⟹ ls ! i = ls' ! i"
proof(induct rule:eval⇩1_evals⇩1_inducts)
case (RInitInitFail⇩1 e h l sh a h' l' sh' C sfs i sh'' D Cs e⇩1 h⇩1 l⇩1 sh⇩1)
have "final (throw a)" using eval⇩1_final[OF RInitInitFail⇩1.hyps(1)] by simp
then show ?case using RInitInitFail⇩1 by(auto simp: eval⇩1_preserves_len)
qed(auto dest!:eval⇩1_preserves_len evals⇩1_preserves_len split:if_split_asm)
lemma LAss_lem:
"⟦x ∈ set xs; size xs ≤ size ys ⟧
⟹ m⇩1 ⊆⇩m m⇩2(xs[↦]ys) ⟹ m⇩1(x↦y) ⊆⇩m m⇩2(xs[↦]ys[last_index xs x := y])"
by(simp add:map_le_def fun_upds_apply eq_sym_conv)
lemma Block_lem:
fixes l :: "'a ⇀ 'b"
assumes 0: "l ⊆⇩m [Vs [↦] ls]"
and 1: "l' ⊆⇩m [Vs [↦] ls', V↦v]"
and hidden: "V ∈ set Vs ⟹ ls ! last_index Vs V = ls' ! last_index Vs V"
and size: "size ls = size ls'" "size Vs < size ls'"
shows "l'(V := l V) ⊆⇩m [Vs [↦] ls']"
proof -
have "l'(V := l V) ⊆⇩m [Vs [↦] ls', V↦v](V := l V)"
using 1 by(rule map_le_upd)
also have "… = [Vs [↦] ls'](V := l V)" by simp
also have "… ⊆⇩m [Vs [↦] ls']"
proof (cases "l V")
case None thus ?thesis by simp
next
case (Some w)
hence "[Vs [↦] ls] V = Some w"
using 0 by(force simp add: map_le_def split:if_splits)
hence VinVs: "V ∈ set Vs" and w: "w = ls ! last_index Vs V"
using size by(auto simp add:fun_upds_apply split:if_splits)
hence "w = ls' ! last_index Vs V" using hidden[OF VinVs] by simp
hence "[Vs [↦] ls'](V := l V) = [Vs [↦] ls']" using Some size VinVs
by(simp add: map_upds_upd_conv_last_index)
thus ?thesis by simp
qed
finally show ?thesis .
qed
declare fun_upd_apply[simp del]
text‹\noindent The main theorem: ›
theorem assumes wf: "wwf_J_prog P"
shows eval⇩1_eval: "P ⊢ ⟨e,(h,l,sh)⟩ ⇒ ⟨e',(h',l',sh')⟩
⟹ (⋀Vs ls. ⟦ fv e ⊆ set Vs; l ⊆⇩m [Vs[↦]ls]; size Vs + max_vars e ≤ size ls ⟧
⟹ ∃ls'. compP⇩1 P ⊢⇩1 ⟨compE⇩1 Vs e,(h,ls,sh)⟩ ⇒ ⟨fin⇩1 e',(h',ls',sh')⟩ ∧ l' ⊆⇩m [Vs[↦]ls'])"
(is "_ ⟹ (⋀Vs ls. PROP ?P e h l sh e' h' l' sh' Vs ls)"
is "_ ⟹ (⋀Vs ls. ⟦ _; _; _ ⟧ ⟹ ∃ls'. ?Post e h l sh e' h' l' sh' Vs ls ls')")
and evals⇩1_evals: "P ⊢ ⟨es,(h,l,sh)⟩ [⇒] ⟨es',(h',l',sh')⟩
⟹ (⋀Vs ls. ⟦ fvs es ⊆ set Vs; l ⊆⇩m [Vs[↦]ls]; size Vs + max_varss es ≤ size ls ⟧
⟹ ∃ls'. compP⇩1 P ⊢⇩1 ⟨compEs⇩1 Vs es,(h,ls,sh)⟩ [⇒] ⟨compEs⇩1 Vs es',(h',ls',sh')⟩ ∧
l' ⊆⇩m [Vs[↦]ls'])"
(is "_ ⟹ (⋀Vs ls. PROP ?Ps es h l sh es' h' l' sh' Vs ls)"
is "_ ⟹ (⋀Vs ls. ⟦ _; _; _⟧ ⟹ ∃ls'. ?Posts es h l sh es' h' l' sh' Vs ls ls')")
proof (induct rule:eval_evals_inducts)
case Nil thus ?case by(fastforce intro!:Nil⇩1)
next
case (Cons e h l sh v h' l' sh' es es' h⇩2 l⇩2 sh⇩2)
have "PROP ?P e h l sh (Val v) h' l' sh' Vs ls" by fact
with Cons.prems
obtain ls' where 1: "?Post e h l sh (Val v) h' l' sh' Vs ls ls'"
"size ls = size ls'" by(auto intro!:eval⇩1_preserves_len)
have "PROP ?Ps es h' l' sh' es' h⇩2 l⇩2 sh⇩2 Vs ls'" by fact
with 1 Cons.prems
obtain ls⇩2 where 2: "?Posts es h' l' sh' es' h⇩2 l⇩2 sh⇩2 Vs ls' ls⇩2" by(auto)
from 1 2 Cons show ?case by(auto intro!:Cons⇩1)
next
case ConsThrow thus ?case
by(fastforce intro!:ConsThrow⇩1 dest: eval_final)
next
case (Block e h l V sh e' h' l' sh' T)
let ?Vs = "Vs @ [V]"
have IH:
"⟦fv e ⊆ set ?Vs; l(V := None) ⊆⇩m [?Vs [↦] ls];
size ?Vs + max_vars e ≤ size ls⟧
⟹ ∃ls'. compP⇩1 P ⊢⇩1 ⟨compE⇩1 ?Vs e,(h,ls,sh)⟩ ⇒ ⟨fin⇩1 e',(h', ls',sh')⟩ ∧
l' ⊆⇩m [?Vs [↦] ls']" and
fv: "fv {V:T; e} ⊆ set Vs" and rel: "l ⊆⇩m [Vs [↦] ls]" and
len: "length Vs + max_vars {V:T; e} ≤ length ls" by fact+
have len': "length Vs < length ls" using len by auto
have "fv e ⊆ set ?Vs" using fv by auto
moreover have "l(V := None) ⊆⇩m [?Vs [↦] ls]" using rel len' by simp
moreover have "size ?Vs + max_vars e ≤ size ls" using len by simp
ultimately obtain ls' where
1: "compP⇩1 P ⊢⇩1 ⟨compE⇩1 ?Vs e,(h,ls,sh)⟩ ⇒ ⟨fin⇩1 e',(h',ls',sh')⟩"
and rel': "l' ⊆⇩m [?Vs [↦] ls']" using IH by blast
have [simp]: "length ls = length ls'" by(rule eval⇩1_preserves_len[OF 1])
show "∃ls'. compP⇩1 P ⊢⇩1 ⟨compE⇩1 Vs {V:T; e},(h,ls,sh)⟩ ⇒ ⟨fin⇩1 e',(h',ls',sh')⟩
∧ l'(V := l V) ⊆⇩m [Vs [↦] ls']" (is "∃ls'. ?R ls'")
proof
show "?R ls'"
proof
show "compP⇩1 P ⊢⇩1 ⟨compE⇩1 Vs {V:T; e},(h,ls,sh)⟩ ⇒ ⟨fin⇩1 e',(h',ls',sh')⟩"
using 1 by(simp add:Block⇩1)
next
show "l'(V := l V) ⊆⇩m [Vs [↦] ls']"
proof -
have "l' ⊆⇩m [Vs [↦] ls', V ↦ ls' ! length Vs]"
using len' rel' by simp
moreover
{ assume VinVs: "V ∈ set Vs"
hence "hidden (Vs @ [V]) (last_index Vs V)"
by(rule hidden_last_index)
hence "unmod (compE⇩1 (Vs @ [V]) e) (last_index Vs V)"
by(rule hidden_unmod)
moreover have "last_index Vs V < length ls"
using len' VinVs by simp
ultimately have "ls ! last_index Vs V = ls' ! last_index Vs V"
by(rule eval⇩1_preserves_unmod[OF 1])
}
ultimately show ?thesis using Block_lem[OF rel] len' by auto
qed
qed
qed
next
case (TryThrow e' h l sh a h' l' sh' D fs C V e⇩2)
have "PROP ?P e' h l sh (Throw a) h' l' sh' Vs ls" by fact
with TryThrow.prems
obtain ls' where 1: "?Post e' h l sh (Throw a) h' l' sh' Vs ls ls'" by(auto)
show ?case using 1 TryThrow.hyps by(auto intro!:eval⇩1_evals⇩1.TryThrow⇩1)
next
case (TryCatch e⇩1 h l sh a h⇩1 l⇩1 sh⇩1 D fs C e⇩2 V e' h⇩2 l⇩2 sh⇩2)
let ?e = "try e⇩1 catch(C V) e⇩2"
have IH⇩1: "⟦fv e⇩1 ⊆ set Vs; l ⊆⇩m [Vs [↦] ls];
size Vs + max_vars e⇩1 ≤ length ls⟧
⟹ ∃ls⇩1. compP⇩1 P ⊢⇩1 ⟨compE⇩1 Vs e⇩1,(h,ls,sh)⟩ ⇒
⟨fin⇩1 (Throw a),(h⇩1,ls⇩1,sh⇩1)⟩ ∧
l⇩1 ⊆⇩m [Vs [↦] ls⇩1]" and
fv: "fv ?e ⊆ set Vs" and
rel: "l ⊆⇩m [Vs [↦] ls]" and
len: "length Vs + max_vars ?e ≤ length ls" by fact+
have "fv e⇩1 ⊆ set Vs" using fv by auto
moreover have "length Vs + max_vars e⇩1 ≤ length ls" using len by(auto)
ultimately obtain ls⇩1 where
1: "compP⇩1 P ⊢⇩1 ⟨compE⇩1 Vs e⇩1,(h,ls,sh)⟩ ⇒ ⟨Throw a,(h⇩1,ls⇩1,sh⇩1)⟩"
and rel⇩1: "l⇩1 ⊆⇩m [Vs [↦] ls⇩1]" using IH⇩1 rel by fastforce
from 1 have [simp]: "size ls = size ls⇩1" by(rule eval⇩1_preserves_len)
let ?Vs = "Vs @ [V]" let ?ls = "(ls⇩1[size Vs:=Addr a])"
have IH⇩2: "⟦fv e⇩2 ⊆ set ?Vs; l⇩1(V ↦ Addr a) ⊆⇩m [?Vs [↦] ?ls];
length ?Vs + max_vars e⇩2 ≤ length ?ls⟧ ⟹ ∃ls⇩2.
compP⇩1 P ⊢⇩1 ⟨compE⇩1 ?Vs e⇩2,(h⇩1,?ls,sh⇩1)⟩ ⇒ ⟨fin⇩1 e',(h⇩2, ls⇩2, sh⇩2)⟩ ∧
l⇩2 ⊆⇩m [?Vs [↦] ls⇩2]" by fact
have len⇩1: "size Vs < size ls⇩1" using len by(auto)
have "fv e⇩2 ⊆ set ?Vs" using fv by auto
moreover have "l⇩1(V ↦ Addr a) ⊆⇩m [?Vs [↦] ?ls]" using rel⇩1 len⇩1 by simp
moreover have "length ?Vs + max_vars e⇩2 ≤ length ?ls" using len by(auto)
ultimately obtain ls⇩2 where
2: "compP⇩1 P ⊢⇩1 ⟨compE⇩1 ?Vs e⇩2,(h⇩1,?ls,sh⇩1)⟩ ⇒ ⟨fin⇩1 e',(h⇩2, ls⇩2, sh⇩2)⟩"
and rel⇩2: "l⇩2 ⊆⇩m [?Vs [↦] ls⇩2]" using IH⇩2 by blast
from 2 have [simp]: "size ls⇩1 = size ls⇩2"
by(fastforce dest: eval⇩1_preserves_len)
show "∃ls⇩2. compP⇩1 P ⊢⇩1 ⟨compE⇩1 Vs ?e,(h,ls,sh)⟩ ⇒ ⟨fin⇩1 e',(h⇩2,ls⇩2,sh⇩2)⟩ ∧
l⇩2(V := l⇩1 V) ⊆⇩m [Vs [↦] ls⇩2]" (is "∃ls⇩2. ?R ls⇩2")
proof
show "?R ls⇩2"
proof
have hp: "h⇩1 a = Some (D, fs)" by fact
have "P ⊢ D ≼⇧* C" by fact hence caught: "compP⇩1 P ⊢ D ≼⇧* C" by simp
from TryCatch⇩1[OF 1 _ caught len⇩1 2, OF hp]
show "compP⇩1 P ⊢⇩1 ⟨compE⇩1 Vs ?e,(h,ls,sh)⟩ ⇒ ⟨fin⇩1 e',(h⇩2,ls⇩2,sh⇩2)⟩" by simp
next
show "l⇩2(V := l⇩1 V) ⊆⇩m [Vs [↦] ls⇩2]"
proof -
have "l⇩2 ⊆⇩m [Vs [↦] ls⇩2, V ↦ ls⇩2 ! length Vs]"
using len⇩1 rel⇩2 by simp
moreover
{ assume VinVs: "V ∈ set Vs"
hence "hidden (Vs @ [V]) (last_index Vs V)" by(rule hidden_last_index)
hence "unmod (compE⇩1 (Vs @ [V]) e⇩2) (last_index Vs V)"
by(rule hidden_unmod)
moreover have "last_index Vs V < length ?ls"
using len⇩1 VinVs by simp
ultimately have "?ls ! last_index Vs V = ls⇩2 ! last_index Vs V"
by(rule eval⇩1_preserves_unmod[OF 2])
moreover have "last_index Vs V < size Vs" using VinVs by simp
ultimately have "ls⇩1 ! last_index Vs V = ls⇩2 ! last_index Vs V"
using len⇩1 by(simp del:size_last_index_conv)
}
ultimately show ?thesis using Block_lem[OF rel⇩1] len⇩1 by simp
qed
qed
qed
next
case Try thus ?case by(fastforce intro!:Try⇩1)
next
case Throw thus ?case by(fastforce intro!:Throw⇩1)
next
case ThrowNull thus ?case by(fastforce intro!:ThrowNull⇩1)
next
case ThrowThrow thus ?case by(fastforce intro!:ThrowThrow⇩1)
next
case (CondT e h l sh h⇩1 l⇩1 sh⇩1 e⇩1 e' h⇩2 l⇩2 sh⇩2 e⇩2)
have "PROP ?P e h l sh true h⇩1 l⇩1 sh⇩1 Vs ls" by fact
with CondT.prems
obtain ls⇩1 where 1: "?Post e h l sh true h⇩1 l⇩1 sh⇩1 Vs ls ls⇩1"
"size ls = size ls⇩1" by(auto intro!:eval⇩1_preserves_len)
have "PROP ?P e⇩1 h⇩1 l⇩1 sh⇩1 e' h⇩2 l⇩2 sh⇩2 Vs ls⇩1" by fact
with 1 CondT.prems
obtain ls⇩2 where 2: "?Post e⇩1 h⇩1 l⇩1 sh⇩1 e' h⇩2 l⇩2 sh⇩2 Vs ls⇩1 ls⇩2" by(auto)
from 1 2 show ?case by(auto intro!:CondT⇩1)
next
case (CondF e h l sh h⇩1 l⇩1 sh⇩1 e⇩2 e' h⇩2 l⇩2 sh⇩2 e⇩1 Vs ls)
have "PROP ?P e h l sh false h⇩1 l⇩1 sh⇩1 Vs ls" by fact
with CondF.prems
obtain ls⇩1 where 1: "?Post e h l sh false h⇩1 l⇩1 sh⇩1 Vs ls ls⇩1"
"size ls = size ls⇩1" by(auto intro!:eval⇩1_preserves_len)
have "PROP ?P e⇩2 h⇩1 l⇩1 sh⇩1 e' h⇩2 l⇩2 sh⇩2 Vs ls⇩1" by fact
with 1 CondF.prems
obtain ls⇩2 where 2: "?Post e⇩2 h⇩1 l⇩1 sh⇩1 e' h⇩2 l⇩2 sh⇩2 Vs ls⇩1 ls⇩2" by(auto)
from 1 2 show ?case by(auto intro!:CondF⇩1)
next
case CondThrow thus ?case by(fastforce intro!:CondThrow⇩1)
next
case (Seq e h l sh v h⇩1 l⇩1 sh⇩1 e⇩1 e' h⇩2 l⇩2 sh⇩2)
have "PROP ?P e h l sh (Val v) h⇩1 l⇩1 sh⇩1 Vs ls" by fact
with Seq.prems
obtain ls⇩1 where 1: "?Post e h l sh (Val v) h⇩1 l⇩1 sh⇩1 Vs ls ls⇩1"
"size ls = size ls⇩1" by(auto intro!:eval⇩1_preserves_len)
have "PROP ?P e⇩1 h⇩1 l⇩1 sh⇩1 e' h⇩2 l⇩2 sh⇩2 Vs ls⇩1" by fact
with 1 Seq.prems
obtain ls⇩2 where 2: "?Post e⇩1 h⇩1 l⇩1 sh⇩1 e' h⇩2 l⇩2 sh⇩2 Vs ls⇩1 ls⇩2" by(auto)
from 1 2 Seq show ?case by(auto intro!:Seq⇩1)
next
case SeqThrow thus ?case by(fastforce intro!:SeqThrow⇩1)
next
case WhileF thus ?case by(fastforce intro!:eval⇩1_evals⇩1.intros)
next
case (WhileT e h l sh h⇩1 l⇩1 sh⇩1 c v h⇩2 l⇩2 sh⇩2 e' h⇩3 l⇩3 sh⇩3)
have "PROP ?P e h l sh true h⇩1 l⇩1 sh⇩1 Vs ls" by fact
with WhileT.prems
obtain ls⇩1 where 1: "?Post e h l sh true h⇩1 l⇩1 sh⇩1 Vs ls ls⇩1"
"size ls = size ls⇩1" by(auto intro!:eval⇩1_preserves_len)
have "PROP ?P c h⇩1 l⇩1 sh⇩1 (Val v) h⇩2 l⇩2 sh⇩2 Vs ls⇩1" by fact
with 1 WhileT.prems
obtain ls⇩2 where 2: "?Post c h⇩1 l⇩1 sh⇩1 (Val v) h⇩2 l⇩2 sh⇩2 Vs ls⇩1 ls⇩2"
"size ls⇩1 = size ls⇩2" by(auto intro!:eval⇩1_preserves_len)
have "PROP ?P (While (e) c) h⇩2 l⇩2 sh⇩2 e' h⇩3 l⇩3 sh⇩3 Vs ls⇩2" by fact
with 1 2 WhileT.prems
obtain ls⇩3 where 3: "?Post (While (e) c) h⇩2 l⇩2 sh⇩2 e' h⇩3 l⇩3 sh⇩3 Vs ls⇩2 ls⇩3" by(auto)
from 1 2 3 show ?case by(auto intro!:WhileT⇩1)
next
case (WhileBodyThrow e h l sh h⇩1 l⇩1 sh⇩1 c e' h⇩2 l⇩2 sh⇩2)
have "PROP ?P e h l sh true h⇩1 l⇩1 sh⇩1 Vs ls" by fact
with WhileBodyThrow.prems
obtain ls⇩1 where 1: "?Post e h l sh true h⇩1 l⇩1 sh⇩1 Vs ls ls⇩1"
"size ls = size ls⇩1" by(auto intro!:eval⇩1_preserves_len)
have "PROP ?P c h⇩1 l⇩1 sh⇩1 (throw e') h⇩2 l⇩2 sh⇩2 Vs ls⇩1" by fact
with 1 WhileBodyThrow.prems
obtain ls⇩2 where 2: "?Post c h⇩1 l⇩1 sh⇩1 (throw e') h⇩2 l⇩2 sh⇩2 Vs ls⇩1 ls⇩2" by auto
from 1 2 show ?case by(auto intro!:WhileBodyThrow⇩1)
next
case WhileCondThrow thus ?case by(fastforce intro!:WhileCondThrow⇩1)
next
case New thus ?case by(fastforce intro:eval⇩1_evals⇩1.intros)
next
case NewFail thus ?case by(fastforce intro:eval⇩1_evals⇩1.intros)
next
case NewInit then show ?case by(fastforce intro:eval⇩1_evals⇩1.intros)
next
case NewInitOOM then show ?case by(fastforce intro:eval⇩1_evals⇩1.intros)
next
case NewInitThrow then show ?case by(fastforce intro:eval⇩1_evals⇩1.intros)
next
case Cast thus ?case by(fastforce intro:eval⇩1_evals⇩1.intros)
next
case CastNull thus ?case by(fastforce intro:eval⇩1_evals⇩1.intros)
next
case CastThrow thus ?case by(fastforce intro:eval⇩1_evals⇩1.intros)
next
case (CastFail e h l sh a h⇩1 l⇩1 sh⇩1 D fs C)
have "PROP ?P e h l sh (addr a) h⇩1 l⇩1 sh⇩1 Vs ls" by fact
with CastFail.prems
obtain ls⇩1 where 1: "?Post e h l sh (addr a) h⇩1 l⇩1 sh⇩1 Vs ls ls⇩1" by auto
show ?case using 1 CastFail.hyps
by(auto intro!:CastFail⇩1[where D=D])
next
case Val thus ?case by(fastforce intro:eval⇩1_evals⇩1.intros)
next
case (BinOp e h l sh v⇩1 h⇩1 l⇩1 sh⇩1 e⇩1 v⇩2 h⇩2 l⇩2 sh⇩2 bop v)
have "PROP ?P e h l sh (Val v⇩1) h⇩1 l⇩1 sh⇩1 Vs ls" by fact
with BinOp.prems
obtain ls⇩1 where 1: "?Post e h l sh (Val v⇩1) h⇩1 l⇩1 sh⇩1 Vs ls ls⇩1"
"size ls = size ls⇩1" by(auto intro!:eval⇩1_preserves_len)
have "PROP ?P e⇩1 h⇩1 l⇩1 sh⇩1 (Val v⇩2) h⇩2 l⇩2 sh⇩2 Vs ls⇩1" by fact
with 1 BinOp.prems
obtain ls⇩2 where 2: "?Post e⇩1 h⇩1 l⇩1 sh⇩1 (Val v⇩2) h⇩2 l⇩2 sh⇩2 Vs ls⇩1 ls⇩2" by(auto)
from 1 2 BinOp show ?case by(auto intro!:BinOp⇩1)
next
case (BinOpThrow2 e⇩0 h l sh v⇩1 h⇩1 l⇩1 sh⇩1 e⇩1 e h⇩2 l⇩2 sh⇩2 bop)
have "PROP ?P e⇩0 h l sh (Val v⇩1) h⇩1 l⇩1 sh⇩1 Vs ls" by fact
with BinOpThrow2.prems
obtain ls⇩1 where 1: "?Post e⇩0 h l sh (Val v⇩1) h⇩1 l⇩1 sh⇩1 Vs ls ls⇩1"
"size ls = size ls⇩1" by(auto intro!:eval⇩1_preserves_len)
have "PROP ?P e⇩1 h⇩1 l⇩1 sh⇩1 (throw e) h⇩2 l⇩2 sh⇩2 Vs ls⇩1" by fact
with 1 BinOpThrow2.prems
obtain ls⇩2 where 2: "?Post e⇩1 h⇩1 l⇩1 sh⇩1 (throw e) h⇩2 l⇩2 sh⇩2 Vs ls⇩1 ls⇩2" by(auto)
from 1 2 BinOpThrow2 show ?case by(auto intro!:BinOpThrow⇩2⇩1)
next
case BinOpThrow1 thus ?case by(fastforce intro!:eval⇩1_evals⇩1.intros)
next
case Var thus ?case
by(force intro!:Var⇩1 simp add: map_le_def fun_upds_apply)
next
case LAss thus ?case
by(fastforce simp add: LAss_lem intro:eval⇩1_evals⇩1.intros
dest:eval⇩1_preserves_len)
next
case LAssThrow thus ?case by(fastforce intro:eval⇩1_evals⇩1.intros)
next
case FAcc thus ?case by(fastforce intro:eval⇩1_evals⇩1.intros)
next
case FAccNull thus ?case by(fastforce intro:eval⇩1_evals⇩1.intros)
next
case FAccThrow thus ?case by(fastforce intro:eval⇩1_evals⇩1.intros)
next
case (FAccNone e h l sh a h' l' sh' C fs F D)
have "PROP ?P e h l sh (addr a) h' l' sh' Vs ls" by fact
with FAccNone.prems
obtain ls⇩2 where 2: "?Post e h l sh (addr a) h' l' sh' Vs ls ls⇩2" by(auto)
from 2 FAccNone show ?case by(rule_tac x = ls⇩2 in exI, auto elim!: FAccNone⇩1)
next
case (FAccStatic e h l sh a h' l' sh' C fs F t D)
have "PROP ?P e h l sh (addr a) h' l' sh' Vs ls" by fact
with FAccStatic.prems
obtain ls⇩2 where 2: "?Post e h l sh (addr a) h' l' sh' Vs ls ls⇩2" by(auto)
from 2 FAccStatic show ?case by(rule_tac x = ls⇩2 in exI, auto elim!: FAccStatic⇩1)
next
case SFAcc then show ?case by(fastforce intro:eval⇩1_evals⇩1.intros)
next
case (SFAccInit C F t D sh h l v' h' l' sh' sfs i v)
have "PROP ?P (INIT D ([D],False) ← unit) h l sh (Val v') h' l' sh' Vs ls" by fact
with SFAccInit.prems
obtain ls⇩2 where 1: "?Post (INIT D ([D],False) ← unit) h l sh (Val v') h' l' sh' Vs ls ls⇩2" by(auto)
from 1 SFAccInit show ?case by(rule_tac x = ls⇩2 in exI, auto intro: SFAccInit⇩1)
next
case (SFAccInitThrow C F t D sh h l a h' l' sh')
have "PROP ?P (INIT D ([D],False) ← unit) h l sh (throw a) h' l' sh' Vs ls" by fact
with SFAccInitThrow.prems
obtain ls⇩2 where 1: "?Post (INIT D ([D],False) ← unit) h l sh (throw a) h' l' sh' Vs ls ls⇩2" by(auto)
from 1 SFAccInitThrow show ?case by(rule_tac x = ls⇩2 in exI, auto intro: SFAccInitThrow⇩1)
next
case SFAccNone then show ?case by(fastforce intro:eval⇩1_evals⇩1.intros)
next
case SFAccNonStatic then show ?case by(fastforce intro:eval⇩1_evals⇩1.intros)
next
case (FAss e⇩1 h l sh a h⇩1 l⇩1 sh⇩1 e⇩2 v h⇩2 l⇩2 sh⇩2 C fs fs' F D h⇩2')
have "PROP ?P e⇩1 h l sh (addr a) h⇩1 l⇩1 sh⇩1 Vs ls" by fact
with FAss.prems
obtain ls⇩1 where 1: "?Post e⇩1 h l sh (addr a) h⇩1 l⇩1 sh⇩1 Vs ls ls⇩1"
"size ls = size ls⇩1" by(auto intro!:eval⇩1_preserves_len)
have "PROP ?P e⇩2 h⇩1 l⇩1 sh⇩1 (Val v) h⇩2 l⇩2 sh⇩2 Vs ls⇩1" by fact
with 1 FAss.prems
obtain ls⇩2 where 2: "?Post e⇩2 h⇩1 l⇩1 sh⇩1 (Val v) h⇩2 l⇩2 sh⇩2 Vs ls⇩1 ls⇩2" by(auto)
from 1 2 FAss show ?case by(auto intro!:FAss⇩1)
next
case (FAssNull e⇩1 h l sh h⇩1 l⇩1 sh⇩1 e⇩2 v h⇩2 l⇩2 sh⇩2 F D)
have "PROP ?P e⇩1 h l sh null h⇩1 l⇩1 sh⇩1 Vs ls" by fact
with FAssNull.prems
obtain ls⇩1 where 1: "?Post e⇩1 h l sh null h⇩1 l⇩1 sh⇩1 Vs ls ls⇩1"
"size ls = size ls⇩1" by(auto intro!:eval⇩1_preserves_len)
have "PROP ?P e⇩2 h⇩1 l⇩1 sh⇩1 (Val v) h⇩2 l⇩2 sh⇩2 Vs ls⇩1" by fact
with 1 FAssNull.prems
obtain ls⇩2 where 2: "?Post e⇩2 h⇩1 l⇩1 sh⇩1 (Val v) h⇩2 l⇩2 sh⇩2 Vs ls⇩1 ls⇩2" by(auto)
from 1 2 FAssNull show ?case by(auto intro!:FAssNull⇩1)
next
case FAssThrow1 thus ?case by(fastforce intro:eval⇩1_evals⇩1.intros)
next
case (FAssThrow2 e⇩1 h l sh v h⇩1 l⇩1 sh⇩1 e⇩2 e h⇩2 l⇩2 sh⇩2 F D)
have "PROP ?P e⇩1 h l sh (Val v) h⇩1 l⇩1 sh⇩1 Vs ls" by fact
with FAssThrow2.prems
obtain ls⇩1 where 1: "?Post e⇩1 h l sh (Val v) h⇩1 l⇩1 sh⇩1 Vs ls ls⇩1"
"size ls = size ls⇩1" by(auto intro!:eval⇩1_preserves_len)
have "PROP ?P e⇩2 h⇩1 l⇩1 sh⇩1 (throw e) h⇩2 l⇩2 sh⇩2 Vs ls⇩1" by fact
with 1 FAssThrow2.prems
obtain ls⇩2 where 2: "?Post e⇩2 h⇩1 l⇩1 sh⇩1 (throw e) h⇩2 l⇩2 sh⇩2 Vs ls⇩1 ls⇩2" by(auto)
from 1 2 FAssThrow2 show ?case by(auto intro!:FAssThrow⇩2⇩1)
next
case (FAssNone e⇩1 h l sh a h' l' sh' e⇩2 v h⇩2 l⇩2 sh⇩2 C fs F D)
have "PROP ?P e⇩1 h l sh (addr a) h' l' sh' Vs ls" by fact
with FAssNone.prems
obtain ls⇩1 where 1: "?Post e⇩1 h l sh (addr a) h' l' sh' Vs ls ls⇩1"
"size ls = size ls⇩1" by(auto intro!:eval⇩1_preserves_len)
have "PROP ?P e⇩2 h' l' sh' (Val v) h⇩2 l⇩2 sh⇩2 Vs ls⇩1" by fact
with 1 FAssNone.prems
obtain ls⇩2 where 2: "?Post e⇩2 h' l' sh' (Val v) h⇩2 l⇩2 sh⇩2 Vs ls⇩1 ls⇩2" by(auto)
from 1 2 FAssNone show ?case by(auto intro!:FAssNone⇩1)
next
case (FAssStatic e⇩1 h l sh a h' l' sh' e⇩2 v h⇩2 l⇩2 sh⇩2 C fs F t D)
have "PROP ?P e⇩1 h l sh (addr a) h' l' sh' Vs ls" by fact
with FAssStatic.prems
obtain ls⇩1 where 1: "?Post e⇩1 h l sh (addr a) h' l' sh' Vs ls ls⇩1"
"size ls = size ls⇩1" by(auto intro!:eval⇩1_preserves_len)
have "PROP ?P e⇩2 h' l' sh' (Val v) h⇩2 l⇩2 sh⇩2 Vs ls⇩1" by fact
with 1 FAssStatic.prems
obtain ls⇩2 where 2: "?Post e⇩2 h' l' sh' (Val v) h⇩2 l⇩2 sh⇩2 Vs ls⇩1 ls⇩2" by(auto)
from 1 2 FAssStatic show ?case by(auto intro!:FAssStatic⇩1)
next
case SFAss then show ?case by(fastforce intro:eval⇩1_evals⇩1.intros)
next
case (SFAssInit e⇩2 h l sh v h⇩1 l⇩1 sh⇩1 C F t D v' h' l' sh' sfs i sfs' sh'')
have "PROP ?P e⇩2 h l sh (Val v) h⇩1 l⇩1 sh⇩1 Vs ls" by fact
with SFAssInit.prems
obtain ls⇩1 where 1: "?Post e⇩2 h l sh (Val v) h⇩1 l⇩1 sh⇩1 Vs ls ls⇩1" "length ls = length ls⇩1"
by(auto intro!:eval⇩1_preserves_len)
then have Init_size: "length Vs ≤ length ls⇩1" using SFAssInit.prems(3) by linarith
have "PROP ?P (INIT D ([D],False) ← unit) h⇩1 l⇩1 sh⇩1 (Val v') h' l' sh' Vs ls⇩1" by fact
with 1 Init_size SFAssInit.prems
obtain ls⇩2 where 2: "?Post (INIT D ([D],False) ← unit) h⇩1 l⇩1 sh⇩1 (Val v') h' l' sh' Vs ls⇩1 ls⇩2"
by auto
from 1 2 SFAssInit show ?case
by(auto simp add: comp_def
intro!: SFAssInit⇩1 dest!:evals_final)
next
case (SFAssInitThrow e⇩2 h l sh v h⇩1 l⇩1 sh⇩1 C F t D a h⇩2 l⇩2 sh⇩2)
have "PROP ?P e⇩2 h l sh (Val v) h⇩1 l⇩1 sh⇩1 Vs ls" by fact
with SFAssInitThrow.prems
obtain ls⇩1 where 1: "?Post e⇩2 h l sh (Val v) h⇩1 l⇩1 sh⇩1 Vs ls ls⇩1" "length ls = length ls⇩1"
by(auto intro!:eval⇩1_preserves_len)
then have Init_size: "length Vs ≤ length ls⇩1" using SFAssInitThrow.prems(3) by linarith
have "PROP ?P (INIT D ([D],False) ← unit) h⇩1 l⇩1 sh⇩1 (throw a) h⇩2 l⇩2 sh⇩2 Vs ls⇩1" by fact
with 1 Init_size SFAssInitThrow.prems
obtain ls⇩2 where 2: "?Post (INIT D ([D],False) ← unit) h⇩1 l⇩1 sh⇩1 (throw a) h⇩2 l⇩2 sh⇩2 Vs ls⇩1 ls⇩2"
by auto
from 1 2 SFAssInitThrow show ?case
by(auto simp add: comp_def
intro!: SFAssInitThrow⇩1 dest!:evals_final)
next
case SFAssThrow then show ?case by(fastforce intro:eval⇩1_evals⇩1.intros)
next
case (SFAssNone e⇩2 h l sh v h⇩2 l⇩2 sh⇩2 C F D)
have "PROP ?P e⇩2 h l sh (Val v) h⇩2 l⇩2 sh⇩2 Vs ls" by fact
with SFAssNone.prems
obtain ls⇩2 where 2: "?Post e⇩2 h l sh (Val v) h⇩2 l⇩2 sh⇩2 Vs ls ls⇩2" by(auto)
from 2 SFAssNone show ?case by(rule_tac x = ls⇩2 in exI, auto elim!: SFAssNone⇩1)
next
case SFAssNonStatic then show ?case by(fastforce intro:eval⇩1_evals⇩1.intros)
next
case (CallNull e h l sh h⇩1 l⇩1 sh⇩1 es vs h⇩2 l⇩2 sh⇩2 M)
have "PROP ?P e h l sh null h⇩1 l⇩1 sh⇩1 Vs ls" by fact
with CallNull.prems
obtain ls⇩1 where 1: "?Post e h l sh null h⇩1 l⇩1 sh⇩1 Vs ls ls⇩1"
"size ls = size ls⇩1" by(auto intro!:eval⇩1_preserves_len)
have "PROP ?Ps es h⇩1 l⇩1 sh⇩1 (map Val vs) h⇩2 l⇩2 sh⇩2 Vs ls⇩1" by fact
with 1 CallNull.prems
obtain ls⇩2 where 2: "?Posts es h⇩1 l⇩1 sh⇩1 (map Val vs) h⇩2 l⇩2 sh⇩2 Vs ls⇩1 ls⇩2" by(auto)
from 1 2 CallNull show ?case
by (auto simp add: comp_def elim!: CallNull⇩1)
next
case CallObjThrow thus ?case by(fastforce intro:eval⇩1_evals⇩1.intros)
next
case (CallParamsThrow e h l sh v h⇩1 l⇩1 sh⇩1 es vs ex es' h⇩2 l⇩2 sh⇩2 M)
have "PROP ?P e h l sh (Val v) h⇩1 l⇩1 sh⇩1 Vs ls" by fact
with CallParamsThrow.prems
obtain ls⇩1 where 1: "?Post e h l sh (Val v) h⇩1 l⇩1 sh⇩1 Vs ls ls⇩1"
"size ls = size ls⇩1" by(auto intro!:eval⇩1_preserves_len)
have "PROP ?Ps es h⇩1 l⇩1 sh⇩1 (map Val vs @ throw ex # es') h⇩2 l⇩2 sh⇩2 Vs ls⇩1" by fact
with 1 CallParamsThrow.prems
obtain ls⇩2 where 2: "?Posts es h⇩1 l⇩1 sh⇩1 (map Val vs @ throw ex # es') h⇩2 l⇩2 sh⇩2 Vs ls⇩1 ls⇩2" by(auto)
from 1 2 CallParamsThrow show ?case
by (auto simp add: comp_def
elim!: CallParamsThrow⇩1 dest!:evals_final)
next
case (CallNone e h l sh a h⇩1 l⇩1 sh⇩1 ps vs h⇩2 l⇩2 sh⇩2 C fs M)
have "PROP ?P e h l sh (addr a) h⇩1 l⇩1 sh⇩1 Vs ls" by fact
with CallNone.prems
obtain ls⇩1 where 1: "?Post e h l sh (addr a) h⇩1 l⇩1 sh⇩1 Vs ls ls⇩1"
"size ls = size ls⇩1" by(auto intro!:eval⇩1_preserves_len)
have "PROP ?Ps ps h⇩1 l⇩1 sh⇩1 (map Val vs) h⇩2 l⇩2 sh⇩2 Vs ls⇩1" by fact
with 1 CallNone.prems
obtain ls⇩2 where 2: "?Posts ps h⇩1 l⇩1 sh⇩1 (map Val vs) h⇩2 l⇩2 sh⇩2 Vs ls⇩1 ls⇩2" by(auto)
from 1 2 CallNone show ?case
by (auto simp add: comp_def
elim!: CallNone⇩1 dest!:evals_final sees_method_compPD)
next
case (CallStatic e h l sh a h⇩1 l⇩1 sh⇩1 ps vs h⇩2 l⇩2 sh⇩2 C fs M Ts T pns body D)
have "PROP ?P e h l sh (addr a) h⇩1 l⇩1 sh⇩1 Vs ls" by fact
with CallStatic.prems
obtain ls⇩1 where 1: "?Post e h l sh (addr a) h⇩1 l⇩1 sh⇩1 Vs ls ls⇩1"
"size ls = size ls⇩1" by(auto intro!:eval⇩1_preserves_len)
let ?Vs = pns
have mdecl: "P ⊢ C sees M,Static: Ts→T = (pns, body) in D" by fact
have mdecl⇩1: "compP⇩1 P ⊢ C sees M,Static: Ts→T = (compE⇩1 ?Vs body) in D"
using sees_method_compP[OF mdecl, of "λb (pns,e). compE⇩1 (case b of NonStatic ⇒ this#pns | Static ⇒ pns) e"]
by(simp)
have "PROP ?Ps ps h⇩1 l⇩1 sh⇩1 (map Val vs) h⇩2 l⇩2 sh⇩2 Vs ls⇩1" by fact
with 1 CallStatic.prems
obtain ls⇩2 where 2: "?Posts ps h⇩1 l⇩1 sh⇩1 (map Val vs) h⇩2 l⇩2 sh⇩2 Vs ls⇩1 ls⇩2" by(auto)
from 1 2 mdecl⇩1 CallStatic show ?case
by (auto simp add: comp_def
elim!: CallStatic⇩1 dest!:evals_final)
next
case (Call e h l sh a h⇩1 l⇩1 sh⇩1 es vs h⇩2 l⇩2 sh⇩2 C fs M Ts T pns body D l⇩2' b' h⇩3 l⇩3 sh⇩3)
have "PROP ?P e h l sh (addr a) h⇩1 l⇩1 sh⇩1 Vs ls" by fact
with Call.prems
obtain ls⇩1 where 1: "?Post e h l sh (addr a) h⇩1 l⇩1 sh⇩1 Vs ls ls⇩1"
"size ls = size ls⇩1" by(auto intro!:eval⇩1_preserves_len)
have "PROP ?Ps es h⇩1 l⇩1 sh⇩1 (map Val vs) h⇩2 l⇩2 sh⇩2 Vs ls⇩1" by fact
with 1 Call.prems
obtain ls⇩2 where 2: "?Posts es h⇩1 l⇩1 sh⇩1 (map Val vs) h⇩2 l⇩2 sh⇩2 Vs ls⇩1 ls⇩2"
"size ls⇩1 = size ls⇩2" by(auto intro!:evals⇩1_preserves_len)
let ?Vs = "this#pns"
let ?ls = "Addr a # vs @ replicate (max_vars body) undefined"
have mdecl: "P ⊢ C sees M,NonStatic: Ts→T = (pns, body) in D" by fact
have fv_body: "fv body ⊆ set ?Vs" and wf_size: "size Ts = size pns"
using wf mdecl by(auto dest!:sees_wf_mdecl simp:wf_mdecl_def)
have mdecl⇩1: "compP⇩1 P ⊢ C sees M,NonStatic: Ts→T = (compE⇩1 ?Vs body) in D"
using sees_method_compP[OF mdecl, of "λb (pns,e). compE⇩1 (case b of NonStatic ⇒ this#pns | Static ⇒ pns) e"]
by(simp)
have [simp]: "l⇩2' = [this ↦ Addr a, pns [↦] vs]" by fact
have Call_size: "size vs = size pns" by fact
have "PROP ?P body h⇩2 l⇩2' sh⇩2 b' h⇩3 l⇩3 sh⇩3 ?Vs ?ls" by fact
with 1 2 fv_body Call_size Call.prems
obtain ls⇩3 where 3: "?Post body h⇩2 l⇩2' sh⇩2 b' h⇩3 l⇩3 sh⇩3 ?Vs ?ls ls⇩3" by(auto)
have hp: "h⇩2 a = Some (C, fs)" by fact
from 1 2 3 hp mdecl⇩1 wf_size Call_size show ?case
by(fastforce simp add: comp_def
intro!: Call⇩1 dest!:evals_final)
next
case (SCallParamsThrow es h l sh vs ex es' h⇩2 l⇩2 sh⇩2 C M)
have "PROP ?Ps es h l sh (map Val vs @ throw ex # es') h⇩2 l⇩2 sh⇩2 Vs ls" by fact
with SCallParamsThrow.prems
obtain ls⇩2 where 2: "?Posts es h l sh (map Val vs @ throw ex # es') h⇩2 l⇩2 sh⇩2 Vs ls ls⇩2" by(auto)
from 2 SCallParamsThrow show ?case
by (fastforce simp add: comp_def
elim!: SCallParamsThrow⇩1 dest!:evals_final)
next
case (SCall ps h l sh vs h⇩2 l⇩2 sh⇩2 C M Ts T pns body D sfs l⇩2' e' h⇩3 l⇩3 sh⇩3)
have "PROP ?Ps ps h l sh (map Val vs) h⇩2 l⇩2 sh⇩2 Vs ls" by fact
with SCall.prems
obtain ls⇩2 where 2: "?Posts ps h l sh (map Val vs) h⇩2 l⇩2 sh⇩2 Vs ls ls⇩2"
"size ls = size ls⇩2" by(auto intro!:evals⇩1_preserves_len)
let ?Vs = "pns"
let ?ls = "vs @ replicate (max_vars body) undefined"
have mdecl: "P ⊢ C sees M,Static: Ts→T = (pns, body) in D" by fact
have fv_body: "fv body ⊆ set ?Vs" and wf_size: "size Ts = size pns"
using wf mdecl by(auto dest!:sees_wf_mdecl simp:wf_mdecl_def)
have mdecl⇩1: "compP⇩1 P ⊢ C sees M,Static: Ts→T = (compE⇩1 ?Vs body) in D"
using sees_method_compP[OF mdecl, of "λb (pns,e). compE⇩1 (case b of NonStatic ⇒ this#pns | Static ⇒ pns) e"]
by(simp)
have [simp]: "l⇩2' = [pns [↦] vs]" by fact
have SCall_size: "size vs = size pns" by fact
have "PROP ?P body h⇩2 l⇩2' sh⇩2 e' h⇩3 l⇩3 sh⇩3 ?Vs ?ls" by fact
with 2 fv_body SCall_size SCall.prems
obtain ls⇩3 where 3: "?Post body h⇩2 l⇩2' sh⇩2 e' h⇩3 l⇩3 sh⇩3 ?Vs ?ls ls⇩3" by(auto)
have shp: "sh⇩2 D = ⌊(sfs, Done)⌋ ∨ M = clinit ∧ sh⇩2 D = ⌊(sfs, Processing)⌋" by fact
from 2 3 shp mdecl⇩1 wf_size SCall_size show ?case
by(fastforce simp add: comp_def
intro!: SCall⇩1 dest!:evals_final)
next
case (SCallNone ps h l sh vs h' l' sh' C M)
have "PROP ?Ps ps h l sh (map Val vs) h' l' sh' Vs ls" by fact
with SCallNone.prems
obtain ls⇩2 where 2: "?Posts ps h l sh (map Val vs) h' l' sh' Vs ls ls⇩2" by(auto)
from 2 SCallNone show ?case
by(rule_tac x = ls⇩2 in exI,
auto simp add: comp_def elim!: SCallNone⇩1 dest!:evals_final sees_method_compPD)
next
case (SCallNonStatic ps h l sh vs h' l' sh' C M Ts T pns body D)
let ?Vs = "this#pns"
have mdecl: "P ⊢ C sees M,NonStatic: Ts→T = (pns, body) in D" by fact
have mdecl⇩1: "compP⇩1 P ⊢ C sees M,NonStatic: Ts→T = (compE⇩1 ?Vs body) in D"
using sees_method_compP[OF mdecl, of "λb (pns,e). compE⇩1 (case b of NonStatic ⇒ this#pns | Static ⇒ pns) e"]
by(simp)
have "PROP ?Ps ps h l sh (map Val vs) h' l' sh' Vs ls" by fact
with SCallNonStatic.prems
obtain ls⇩2 where 2: "?Posts ps h l sh (map Val vs) h' l' sh' Vs ls ls⇩2" by(auto)
from 2 mdecl⇩1 SCallNonStatic show ?case
by (auto simp add: comp_def
elim!: SCallNonStatic⇩1 dest!:evals_final)
next
case (SCallInitThrow ps h l sh vs h⇩1 l⇩1 sh⇩1 C M Ts T pns body D a h⇩2 l⇩2 sh⇩2)
have "PROP ?Ps ps h l sh (map Val vs) h⇩1 l⇩1 sh⇩1 Vs ls" by fact
with SCallInitThrow.prems
obtain ls⇩1 where 1: "?Posts ps h l sh (map Val vs) h⇩1 l⇩1 sh⇩1 Vs ls ls⇩1" "length ls = length ls⇩1"
by(auto intro!:evals⇩1_preserves_len)
then have Init_size: "length Vs ≤ length ls⇩1" using SCallInitThrow.prems(3) by linarith
have "PROP ?P (INIT D ([D],False) ← unit) h⇩1 l⇩1 sh⇩1 (throw a) h⇩2 l⇩2 sh⇩2 Vs ls⇩1" by fact
with 1 Init_size SCallInitThrow.prems
obtain ls⇩2 where 2: "?Post (INIT D ([D],False) ← unit) h⇩1 l⇩1 sh⇩1 (throw a) h⇩2 l⇩2 sh⇩2 Vs ls⇩1 ls⇩2"
by auto
let ?Vs = "pns"
have mdecl: "P ⊢ C sees M,Static: Ts→T = (pns, body) in D" by fact
have mdecl⇩1: "compP⇩1 P ⊢ C sees M,Static: Ts→T = (compE⇩1 ?Vs body) in D"
using sees_method_compP[OF mdecl, of "λb (pns,e). compE⇩1 (case b of NonStatic ⇒ this#pns | Static ⇒ pns) e"]
by(simp)
from 1 2 mdecl⇩1 SCallInitThrow show ?case
by(auto simp add: comp_def
intro!: SCallInitThrow⇩1 dest!:evals_final)
next
case (SCallInit ps h l sh vs h⇩1 l⇩1 sh⇩1 C M Ts T pns body D v' h⇩2 l⇩2 sh⇩2 l⇩2' e' h⇩3 l⇩3 sh⇩3)
have "PROP ?Ps ps h l sh (map Val vs) h⇩1 l⇩1 sh⇩1 Vs ls" by fact
with SCallInit.prems
obtain ls⇩1 where 1: "?Posts ps h l sh (map Val vs) h⇩1 l⇩1 sh⇩1 Vs ls ls⇩1" "length ls = length ls⇩1"
by(auto intro!:evals⇩1_preserves_len)
then have Init_size: "length Vs ≤ length ls⇩1" using SCallInit.prems(3) by linarith
have "PROP ?P (INIT D ([D],False) ← unit) h⇩1 l⇩1 sh⇩1 (Val v') h⇩2 l⇩2 sh⇩2 Vs ls⇩1" by fact
with 1 Init_size SCallInit.prems
obtain ls⇩2 where 2: "?Post (INIT D ([D],False) ← unit) h⇩1 l⇩1 sh⇩1 (Val v') h⇩2 l⇩2 sh⇩2 Vs ls⇩1 ls⇩2"
by auto
let ?Vs = "pns"
let ?ls = "vs @ replicate (max_vars body) undefined"
have mdecl: "P ⊢ C sees M,Static: Ts→T = (pns, body) in D" by fact
have fv_body: "fv body ⊆ set ?Vs" and wf_size: "size Ts = size pns"
using wf mdecl by(auto dest!:sees_wf_mdecl simp:wf_mdecl_def)
have mdecl⇩1: "compP⇩1 P ⊢ C sees M,Static: Ts→T = (compE⇩1 ?Vs body) in D"
using sees_method_compP[OF mdecl, of "λb (pns,e). compE⇩1 (case b of NonStatic ⇒ this#pns | Static ⇒ pns) e"]
by(simp)
have [simp]: "l⇩2' = [pns [↦] vs]" by fact
have SCall_size: "size vs = size pns" by fact
have nclinit: "M ≠ clinit" by fact
have "PROP ?P body h⇩2 l⇩2' sh⇩2 e' h⇩3 l⇩3 sh⇩3 ?Vs ?ls" by fact
with 2 fv_body SCall_size SCallInit.prems
obtain ls⇩3 where 3: "?Post body h⇩2 l⇩2' sh⇩2 e' h⇩3 l⇩3 sh⇩3 ?Vs ?ls ls⇩3" by(auto)
have shp: "∄sfs. sh⇩1 D = ⌊(sfs, Done)⌋" by fact
from 1 2 3 shp mdecl⇩1 wf_size SCall_size nclinit show ?case
by(auto simp add: comp_def
intro!: SCallInit⇩1 dest!:evals_final)
next
case InitFinal then show ?case by(fastforce intro:eval⇩1_evals⇩1.intros)
next
case (InitNone sh C C' Cs e h l e' h' l' sh')
let ?sh1 = "sh(C ↦ (sblank P C, Prepared))"
have "PROP ?P (INIT C' (C # Cs,False) ← e) h l ?sh1 e' h' l' sh' Vs ls" by fact
with InitNone.prems
obtain ls⇩2 where 2: "?Post (INIT C' (C # Cs,False) ← e) h l ?sh1 e' h' l' sh' Vs ls ls⇩2" by(auto)
from 2 InitNone show ?case by (auto elim!: InitNone⇩1)
next
case InitDone then show ?case by(fastforce intro:eval⇩1_evals⇩1.intros)
next
case InitProcessing then show ?case by(fastforce intro:eval⇩1_evals⇩1.intros)
next
case InitError then show ?case by(fastforce intro:eval⇩1_evals⇩1.intros)
next
case InitObject then show ?case by(fastforce intro:eval⇩1_evals⇩1.intros)
next
case (InitNonObject sh C sfs D fs ms sh' C' Cs e h l e' h1 l1 sh1)
let ?f = "(λb (pns,body). compE⇩1 (case b of NonStatic ⇒ this#pns | Static ⇒ pns) body)"
have cls: "class (compP ?f P) C = ⌊(D,fs,map (compM ?f) ms)⌋"
by(rule class_compP[OF InitNonObject.hyps(3)])
have "PROP ?P (INIT C' (D # C # Cs,False) ← e) h l sh' e' h1 l1 sh1 Vs ls" by fact
with InitNonObject.prems
obtain ls⇩2 where 2: "?Post (INIT C' (D # C # Cs,False) ← e) h l sh' e' h1 l1 sh1 Vs ls ls⇩2" by(auto)
from 2 cls InitNonObject show ?case by (auto elim!: InitNonObject⇩1)
next
case InitRInit then show ?case by(fastforce intro:eval⇩1_evals⇩1.intros)
next
case (RInit e h l sh v h' l' sh' C sfs i sh'' C' Cs e' e⇩1 h⇩1 l⇩1 sh⇩1)
have "PROP ?P e h l sh (Val v) h' l' sh' Vs ls" by fact
with RInit.prems
obtain ls⇩1 where 1: "?Post e h l sh (Val v) h' l' sh' Vs ls ls⇩1"
"size ls = size ls⇩1" by(auto intro!:eval⇩1_preserves_len)
have "PROP ?P (INIT C' (Cs,True) ← e') h' l' sh'' e⇩1 h⇩1 l⇩1 sh⇩1 Vs ls⇩1" by fact
with 1 RInit.prems
obtain ls⇩2 where 2: "?Post (INIT C' (Cs,True) ← e') h' l' sh'' e⇩1 h⇩1 l⇩1 sh⇩1 Vs ls⇩1 ls⇩2" by(auto)
from 1 2 RInit show ?case by (auto elim!: RInit⇩1)
next
case (RInitInitFail e h l sh a h' l' sh' C sfs i sh'' D Cs e' e⇩1 h⇩1 l⇩1 sh⇩1)
have "PROP ?P e h l sh (throw a) h' l' sh' Vs ls" by fact
with RInitInitFail.prems
obtain ls⇩1 where 1: "?Post e h l sh (throw a) h' l' sh' Vs ls ls⇩1"
"size ls = size ls⇩1" by(auto intro!:eval⇩1_preserves_len)
have fv: "fv (RI (D,throw a) ; Cs ← e') ⊆ set Vs"
using RInitInitFail.hyps(1) eval_final RInitInitFail.prems(1) subset_eq by fastforce
have l': "l' ⊆⇩m [Vs [↦] ls⇩1]" by (simp add: "1"(1))
have "PROP ?P (RI (D,throw a) ; Cs ← e') h' l' sh'' e⇩1 h⇩1 l⇩1 sh⇩1 Vs ls⇩1" by fact
with 1 eval_final[OF RInitInitFail.hyps(1)] RInitInitFail.prems
obtain ls⇩2 where 2: "?Post (RI (D,throw a) ; Cs ← e') h' l' sh'' e⇩1 h⇩1 l⇩1 sh⇩1 Vs ls⇩1 ls⇩2"
by fastforce
from 1 2 RInitInitFail show ?case
by(fastforce simp add: comp_def
intro!: RInitInitFail⇩1 dest!:eval_final)
next
case RInitFailFinal then show ?case by(fastforce intro:eval⇩1_evals⇩1.intros)
qed
subsection‹Preservation of well-formedness›
text‹ The compiler preserves well-formedness. Is less trivial than it
may appear. We start with two simple properties: preservation of
well-typedness ›
lemma compE⇩1_pres_wt: "⋀Vs Ts U.
⟦ P,[Vs[↦]Ts] ⊢ e :: U; size Ts = size Vs ⟧
⟹ compP f P,Ts ⊢⇩1 compE⇩1 Vs e :: U"
and "⋀Vs Ts Us.
⟦ P,[Vs[↦]Ts] ⊢ es [::] Us; size Ts = size Vs ⟧
⟹ compP f P,Ts ⊢⇩1 compEs⇩1 Vs es [::] Us"
apply(induct e and es rule: compE⇩1.induct compEs⇩1.induct)
apply clarsimp
apply(fastforce)
apply clarsimp
apply(fastforce split:bop.splits)
apply (fastforce simp:map_upds_apply_eq_Some split:if_split_asm)
apply (fastforce simp:map_upds_apply_eq_Some split:if_split_asm)
apply(fastforce)
apply(fastforce)
apply(fastforce)
apply(fastforce)
apply (fastforce dest!: sees_method_compP[where f = f])
apply (fastforce dest!: sees_method_compP[where f = f])
apply (fastforce simp:nth_append)
apply (fastforce)
apply (fastforce)
apply (fastforce)
apply (fastforce)
apply (fastforce simp:nth_append)
apply simp
apply simp
apply simp
apply (fastforce)
done
text‹\noindent and the correct block numbering: ›
lemma ℬ: "⋀Vs n. size Vs = n ⟹ ℬ (compE⇩1 Vs e) n"
and ℬs: "⋀Vs n. size Vs = n ⟹ ℬs (compEs⇩1 Vs es) n"
by (induct e and es rule: ℬ.induct ℬs.induct)
(force | simp,metis length_append_singleton)+
text‹ The main complication is preservation of definite assignment
@{term"𝒟"}. ›
lemma image_last_index: "A ⊆ set(xs@[x]) ⟹ last_index (xs @ [x]) ` A =
(if x ∈ A then insert (size xs) (last_index xs ` (A-{x})) else last_index xs ` A)"
by(auto simp:image_def)
lemma A_compE⇩1_None[simp]:
"⋀Vs. 𝒜 e = None ⟹ 𝒜 (compE⇩1 Vs e) = None"
and "⋀Vs. 𝒜s es = None ⟹ 𝒜s (compEs⇩1 Vs es) = None"
by(induct e and es rule: compE⇩1.induct compEs⇩1.induct)(auto simp:hyperset_defs)
lemma A_compE⇩1:
"⋀A Vs. ⟦ 𝒜 e = ⌊A⌋; fv e ⊆ set Vs ⟧ ⟹ 𝒜 (compE⇩1 Vs e) = ⌊last_index Vs ` A⌋"
and "⋀A Vs. ⟦ 𝒜s es = ⌊A⌋; fvs es ⊆ set Vs ⟧ ⟹ 𝒜s (compEs⇩1 Vs es) = ⌊last_index Vs ` A⌋"
proof(induct e and es rule: fv.induct fvs.induct)
case (Block V' T e)
hence "fv e ⊆ set (Vs@[V'])" by fastforce
moreover obtain B where "𝒜 e = ⌊B⌋"
using Block.prems by(simp add: hyperset_defs)
moreover from calculation have "B ⊆ set (Vs@[V'])" by(auto dest!:A_fv)
ultimately show ?case using Block
by(auto simp add: hyperset_defs image_last_index last_index_size_conv)
next
case (TryCatch e⇩1 C V' e⇩2)
hence fve⇩2: "fv e⇩2 ⊆ set (Vs@[V'])" by auto
show ?case
proof (cases "𝒜 e⇩1")
assume A⇩1: "𝒜 e⇩1 = None"
then obtain A⇩2 where A⇩2: "𝒜 e⇩2 = ⌊A⇩2⌋" using TryCatch
by(simp add:hyperset_defs)
hence "A⇩2 ⊆ set (Vs@[V'])" using TryCatch.prems A_fv[OF A⇩2] by simp blast
thus ?thesis using TryCatch fve⇩2 A⇩1 A⇩2
by(auto simp add:hyperset_defs image_last_index last_index_size_conv)
next
fix A⇩1 assume A⇩1: "𝒜 e⇩1 = ⌊A⇩1⌋"
show ?thesis
proof (cases "𝒜 e⇩2")
assume A⇩2: "𝒜 e⇩2 = None"
then show ?case using TryCatch A⇩1 by(simp add:hyperset_defs)
next
fix A⇩2 assume A⇩2: "𝒜 e⇩2 = ⌊A⇩2⌋"
have "A⇩1 ⊆ set Vs" using TryCatch.prems A_fv[OF A⇩1] by simp blast
moreover
have "A⇩2 ⊆ set (Vs@[V'])" using TryCatch.prems A_fv[OF A⇩2] by simp blast
ultimately show ?thesis using TryCatch A⇩1 A⇩2
by (auto simp add: Diff_subset_conv last_index_size_conv subsetD hyperset_defs
dest!: sym [of _ A])
qed
qed
next
case (Cond e e⇩1 e⇩2)
{ assume "𝒜 e = None ∨ 𝒜 e⇩1 = None ∨ 𝒜 e⇩2 = None"
hence ?case using Cond by(auto simp add:hyperset_defs image_Un)
}
moreover
{ fix A A⇩1 A⇩2
assume "𝒜 e = ⌊A⌋" and A⇩1: "𝒜 e⇩1 = ⌊A⇩1⌋" and A⇩2: "𝒜 e⇩2 = ⌊A⇩2⌋"
moreover
have "A⇩1 ⊆ set Vs" using Cond.prems A_fv[OF A⇩1] by simp blast
moreover
have "A⇩2 ⊆ set Vs" using Cond.prems A_fv[OF A⇩2] by simp blast
ultimately have ?case using Cond
by(auto simp add:hyperset_defs image_Un
inj_on_image_Int[OF inj_on_last_index])
}
ultimately show ?case by fastforce
qed (auto simp add:hyperset_defs)
lemma D_None[iff]: "𝒟 (e::'a exp) None" and [iff]: "𝒟s (es::'a exp list) None"
by(induct e and es rule: 𝒟.induct 𝒟s.induct)(simp_all)
lemma D_last_index_compE⇩1:
"⋀A Vs. ⟦ A ⊆ set Vs; fv e ⊆ set Vs ⟧ ⟹
𝒟 e ⌊A⌋ ⟹ 𝒟 (compE⇩1 Vs e) ⌊last_index Vs ` A⌋"
and "⋀A Vs. ⟦ A ⊆ set Vs; fvs es ⊆ set Vs ⟧ ⟹
𝒟s es ⌊A⌋ ⟹ 𝒟s (compEs⇩1 Vs es) ⌊last_index Vs ` A⌋"
proof(induct e and es rule: 𝒟.induct 𝒟s.induct)
case (BinOp e⇩1 bop e⇩2)
hence IH⇩1: "𝒟 (compE⇩1 Vs e⇩1) ⌊last_index Vs ` A⌋" by simp
show ?case
proof (cases "𝒜 e⇩1")
case None thus ?thesis using BinOp by simp
next
case (Some A⇩1)
have indexA⇩1: "𝒜 (compE⇩1 Vs e⇩1) = ⌊last_index Vs ` A⇩1⌋"
using A_compE⇩1[OF Some] BinOp.prems by auto
have "A ∪ A⇩1 ⊆ set Vs" using BinOp.prems A_fv[OF Some] by auto
hence "𝒟 (compE⇩1 Vs e⇩2) ⌊last_index Vs ` (A ∪ A⇩1)⌋" using BinOp Some by auto
hence "𝒟 (compE⇩1 Vs e⇩2) ⌊last_index Vs ` A ∪ last_index Vs ` A⇩1⌋"
by(simp add: image_Un)
thus ?thesis using IH⇩1 indexA⇩1 by auto
qed
next
case (FAss e⇩1 F D e⇩2)
hence IH⇩1: "𝒟 (compE⇩1 Vs e⇩1) ⌊last_index Vs ` A⌋" by simp
show ?case
proof (cases "𝒜 e⇩1")
case None thus ?thesis using FAss by simp
next
case (Some A⇩1)
have indexA⇩1: "𝒜 (compE⇩1 Vs e⇩1) = ⌊last_index Vs ` A⇩1⌋"
using A_compE⇩1[OF Some] FAss.prems by auto
have "A ∪ A⇩1 ⊆ set Vs" using FAss.prems A_fv[OF Some] by auto
hence "𝒟 (compE⇩1 Vs e⇩2) ⌊last_index Vs ` (A ∪ A⇩1)⌋" using FAss Some by auto
hence "𝒟 (compE⇩1 Vs e⇩2) ⌊last_index Vs ` A ∪ last_index Vs ` A⇩1⌋"
by(simp add: image_Un)
thus ?thesis using IH⇩1 indexA⇩1 by auto
qed
next
case (Call e⇩1 M es)
hence IH⇩1: "𝒟 (compE⇩1 Vs e⇩1) ⌊last_index Vs ` A⌋" by simp
show ?case
proof (cases "𝒜 e⇩1")
case None thus ?thesis using Call by simp
next
case (Some A⇩1)
have indexA⇩1: "𝒜 (compE⇩1 Vs e⇩1) = ⌊last_index Vs ` A⇩1⌋"
using A_compE⇩1[OF Some] Call.prems by auto
have "A ∪ A⇩1 ⊆ set Vs" using Call.prems A_fv[OF Some] by auto
hence "𝒟s (compEs⇩1 Vs es) ⌊last_index Vs ` (A ∪ A⇩1)⌋" using Call Some by auto
hence "𝒟s (compEs⇩1 Vs es) ⌊last_index Vs ` A ∪ last_index Vs ` A⇩1⌋"
by(simp add: image_Un)
thus ?thesis using IH⇩1 indexA⇩1 by auto
qed
next
case (TryCatch e⇩1 C V e⇩2)
have "⟦ A∪{V} ⊆ set(Vs@[V]); fv e⇩2 ⊆ set(Vs@[V]); 𝒟 e⇩2 ⌊A∪{V}⌋⟧ ⟹
𝒟 (compE⇩1 (Vs@[V]) e⇩2) ⌊last_index (Vs@[V]) ` (A∪{V})⌋" by fact
hence "𝒟 (compE⇩1 (Vs@[V]) e⇩2) ⌊last_index (Vs@[V]) ` (A∪{V})⌋"
using TryCatch.prems by(simp add:Diff_subset_conv)
moreover have "last_index (Vs@[V]) ` A ⊆ last_index Vs ` A ∪ {size Vs}"
using TryCatch.prems by(auto simp add: image_last_index split:if_split_asm)
ultimately show ?case using TryCatch
by(auto simp:hyperset_defs elim!:D_mono')
next
case (Seq e⇩1 e⇩2)
hence IH⇩1: "𝒟 (compE⇩1 Vs e⇩1) ⌊last_index Vs ` A⌋" by simp
show ?case
proof (cases "𝒜 e⇩1")
case None thus ?thesis using Seq by simp
next
case (Some A⇩1)
have indexA⇩1: "𝒜 (compE⇩1 Vs e⇩1) = ⌊last_index Vs ` A⇩1⌋"
using A_compE⇩1[OF Some] Seq.prems by auto
have "A ∪ A⇩1 ⊆ set Vs" using Seq.prems A_fv[OF Some] by auto
hence "𝒟 (compE⇩1 Vs e⇩2) ⌊last_index Vs ` (A ∪ A⇩1)⌋" using Seq Some by auto
hence "𝒟 (compE⇩1 Vs e⇩2) ⌊last_index Vs ` A ∪ last_index Vs ` A⇩1⌋"
by(simp add: image_Un)
thus ?thesis using IH⇩1 indexA⇩1 by auto
qed
next
case (Cond e e⇩1 e⇩2)
hence IH⇩1: "𝒟 (compE⇩1 Vs e) ⌊last_index Vs ` A⌋" by simp
show ?case
proof (cases "𝒜 e")
case None thus ?thesis using Cond by simp
next
case (Some B)
have indexB: "𝒜 (compE⇩1 Vs e) = ⌊last_index Vs ` B⌋"
using A_compE⇩1[OF Some] Cond.prems by auto
have "A ∪ B ⊆ set Vs" using Cond.prems A_fv[OF Some] by auto
hence "𝒟 (compE⇩1 Vs e⇩1) ⌊last_index Vs ` (A ∪ B)⌋"
and "𝒟 (compE⇩1 Vs e⇩2) ⌊last_index Vs ` (A ∪ B)⌋"
using Cond Some by auto
hence "𝒟 (compE⇩1 Vs e⇩1) ⌊last_index Vs ` A ∪ last_index Vs ` B⌋"
and "𝒟 (compE⇩1 Vs e⇩2) ⌊last_index Vs ` A ∪ last_index Vs ` B⌋"
by(simp add: image_Un)+
thus ?thesis using IH⇩1 indexB by auto
qed
next
case (While e⇩1 e⇩2)
hence IH⇩1: "𝒟 (compE⇩1 Vs e⇩1) ⌊last_index Vs ` A⌋" by simp
show ?case
proof (cases "𝒜 e⇩1")
case None thus ?thesis using While by simp
next
case (Some A⇩1)
have indexA⇩1: "𝒜 (compE⇩1 Vs e⇩1) = ⌊last_index Vs ` A⇩1⌋"
using A_compE⇩1[OF Some] While.prems by auto
have "A ∪ A⇩1 ⊆ set Vs" using While.prems A_fv[OF Some] by auto
hence "𝒟 (compE⇩1 Vs e⇩2) ⌊last_index Vs ` (A ∪ A⇩1)⌋" using While Some by auto
hence "𝒟 (compE⇩1 Vs e⇩2) ⌊last_index Vs ` A ∪ last_index Vs ` A⇩1⌋"
by(simp add: image_Un)
thus ?thesis using IH⇩1 indexA⇩1 by auto
qed
next
case (Block V T e)
have "⟦ A-{V} ⊆ set(Vs@[V]); fv e ⊆ set(Vs@[V]); 𝒟 e ⌊A-{V}⌋ ⟧ ⟹
𝒟 (compE⇩1 (Vs@[V]) e) ⌊last_index (Vs@[V]) ` (A-{V})⌋" by fact
hence "𝒟 (compE⇩1 (Vs@[V]) e) ⌊last_index (Vs@[V]) ` (A-{V})⌋"
using Block.prems by(simp add:Diff_subset_conv)
moreover have "size Vs ∉ last_index Vs ` A"
using Block.prems by(auto simp add:image_def size_last_index_conv)
ultimately show ?case using Block
by(auto simp add: image_last_index Diff_subset_conv hyperset_defs elim!: D_mono')
next
case (Cons_exp e⇩1 es)
hence IH⇩1: "𝒟 (compE⇩1 Vs e⇩1) ⌊last_index Vs ` A⌋" by simp
show ?case
proof (cases "𝒜 e⇩1")
case None thus ?thesis using Cons_exp by simp
next
case (Some A⇩1)
have indexA⇩1: "𝒜 (compE⇩1 Vs e⇩1) = ⌊last_index Vs ` A⇩1⌋"
using A_compE⇩1[OF Some] Cons_exp.prems by auto
have "A ∪ A⇩1 ⊆ set Vs" using Cons_exp.prems A_fv[OF Some] by auto
hence "𝒟s (compEs⇩1 Vs es) ⌊last_index Vs ` (A ∪ A⇩1)⌋" using Cons_exp Some by auto
hence "𝒟s (compEs⇩1 Vs es) ⌊last_index Vs ` A ∪ last_index Vs ` A⇩1⌋"
by(simp add: image_Un)
thus ?thesis using IH⇩1 indexA⇩1 by auto
qed
qed (simp_all add:hyperset_defs)
lemma last_index_image_set: "distinct xs ⟹ last_index xs ` set xs = {..<size xs}"
by(induct xs rule:rev_induct) (auto simp add: image_last_index)
lemma D_compE⇩1:
"⟦ 𝒟 e ⌊set Vs⌋; fv e ⊆ set Vs; distinct Vs ⟧ ⟹ 𝒟 (compE⇩1 Vs e) ⌊{..<length Vs}⌋"
by(fastforce dest!: D_last_index_compE⇩1[OF subset_refl] simp add:last_index_image_set)
lemma D_compE⇩1':
assumes "𝒟 e ⌊set(V#Vs)⌋" and "fv e ⊆ set(V#Vs)" and "distinct(V#Vs)"
shows "𝒟 (compE⇩1 (V#Vs) e) ⌊{..length Vs}⌋"
proof -
have "{..size Vs} = {..<size(V#Vs)}" by auto
thus ?thesis using assms by (simp only:)(rule D_compE⇩1)
qed
lemma compP⇩1_pres_wf: "wf_J_prog P ⟹ wf_J⇩1_prog (compP⇩1 P)"
apply simp
apply(rule wf_prog_compPI)
prefer 2 apply assumption
apply(case_tac m)
apply(simp add:wf_mdecl_def wf_J⇩1_mdecl_def)
apply(clarify) apply(rename_tac C M b Ts T x1 x2 pns body)
apply(case_tac b)
apply clarsimp
apply(frule WT_fv)
apply(auto intro!: compE⇩1_pres_wt D_compE⇩1 ℬ)[1]
apply clarsimp
apply(frule WT_fv)
apply(fastforce intro!: compE⇩1_pres_wt D_compE⇩1' ℬ)
done
end
Theory Compiler2
section ‹ Compilation Stage 2 ›
theory Compiler2
imports PCompiler J1 "../JVM/JVMExec"
begin
lemma bop_expr_length_aux [simp]:
"length (case bop of Eq ⇒ [CmpEq] | Add ⇒ [IAdd]) = Suc 0"
by(cases bop, simp+)
primrec compE⇩2 :: "expr⇩1 ⇒ instr list"
and compEs⇩2 :: "expr⇩1 list ⇒ instr list" where
"compE⇩2 (new C) = [New C]"
| "compE⇩2 (Cast C e) = compE⇩2 e @ [Checkcast C]"
| "compE⇩2 (Val v) = [Push v]"
| "compE⇩2 (e⇩1 «bop» e⇩2) = compE⇩2 e⇩1 @ compE⇩2 e⇩2 @
(case bop of Eq ⇒ [CmpEq]
| Add ⇒ [IAdd])"
| "compE⇩2 (Var i) = [Load i]"
| "compE⇩2 (i:=e) = compE⇩2 e @ [Store i, Push Unit]"
| "compE⇩2 (e∙F{D}) = compE⇩2 e @ [Getfield F D]"
| "compE⇩2 (C∙⇩sF{D}) = [Getstatic C F D]"
| "compE⇩2 (e⇩1∙F{D} := e⇩2) =
compE⇩2 e⇩1 @ compE⇩2 e⇩2 @ [Putfield F D, Push Unit]"
| "compE⇩2 (C∙⇩sF{D} := e⇩2) =
compE⇩2 e⇩2 @ [Putstatic C F D, Push Unit]"
| "compE⇩2 (e∙M(es)) = compE⇩2 e @ compEs⇩2 es @ [Invoke M (size es)]"
| "compE⇩2 (C∙⇩sM(es)) = compEs⇩2 es @ [Invokestatic C M (size es)]"
| "compE⇩2 ({i:T; e}) = compE⇩2 e"
| "compE⇩2 (e⇩1;;e⇩2) = compE⇩2 e⇩1 @ [Pop] @ compE⇩2 e⇩2"
| "compE⇩2 (if (e) e⇩1 else e⇩2) =
(let cnd = compE⇩2 e;
thn = compE⇩2 e⇩1;
els = compE⇩2 e⇩2;
test = IfFalse (int(size thn + 2));
thnex = Goto (int(size els + 1))
in cnd @ [test] @ thn @ [thnex] @ els)"
| "compE⇩2 (while (e) c) =
(let cnd = compE⇩2 e;
bdy = compE⇩2 c;
test = IfFalse (int(size bdy + 3));
loop = Goto (-int(size bdy + size cnd + 2))
in cnd @ [test] @ bdy @ [Pop] @ [loop] @ [Push Unit])"
| "compE⇩2 (throw e) = compE⇩2 e @ [instr.Throw]"
| "compE⇩2 (try e⇩1 catch(C i) e⇩2) =
(let catch = compE⇩2 e⇩2
in compE⇩2 e⇩1 @ [Goto (int(size catch)+2), Store i] @ catch)"
| "compE⇩2 (INIT C (Cs,b) ← e) = []"
| "compE⇩2 (RI(C,e);Cs ← e') = []"
| "compEs⇩2 [] = []"
| "compEs⇩2 (e#es) = compE⇩2 e @ compEs⇩2 es"
text‹ Compilation of exception table. Is given start address of code
to compute absolute addresses necessary in exception table. ›
primrec compxE⇩2 :: "expr⇩1 ⇒ pc ⇒ nat ⇒ ex_table"
and compxEs⇩2 :: "expr⇩1 list ⇒ pc ⇒ nat ⇒ ex_table" where
"compxE⇩2 (new C) pc d = []"
| "compxE⇩2 (Cast C e) pc d = compxE⇩2 e pc d"
| "compxE⇩2 (Val v) pc d = []"
| "compxE⇩2 (e⇩1 «bop» e⇩2) pc d =
compxE⇩2 e⇩1 pc d @ compxE⇩2 e⇩2 (pc + size(compE⇩2 e⇩1)) (d+1)"
| "compxE⇩2 (Var i) pc d = []"
| "compxE⇩2 (i:=e) pc d = compxE⇩2 e pc d"
| "compxE⇩2 (e∙F{D}) pc d = compxE⇩2 e pc d"
| "compxE⇩2 (C∙⇩sF{D}) pc d = []"
| "compxE⇩2 (e⇩1∙F{D} := e⇩2) pc d =
compxE⇩2 e⇩1 pc d @ compxE⇩2 e⇩2 (pc + size(compE⇩2 e⇩1)) (d+1)"
| "compxE⇩2 (C∙⇩sF{D} := e⇩2) pc d = compxE⇩2 e⇩2 pc d"
| "compxE⇩2 (e∙M(es)) pc d =
compxE⇩2 e pc d @ compxEs⇩2 es (pc + size(compE⇩2 e)) (d+1)"
| "compxE⇩2 (C∙⇩sM(es)) pc d = compxEs⇩2 es pc d"
| "compxE⇩2 ({i:T; e}) pc d = compxE⇩2 e pc d"
| "compxE⇩2 (e⇩1;;e⇩2) pc d =
compxE⇩2 e⇩1 pc d @ compxE⇩2 e⇩2 (pc+size(compE⇩2 e⇩1)+1) d"
| "compxE⇩2 (if (e) e⇩1 else e⇩2) pc d =
(let pc⇩1 = pc + size(compE⇩2 e) + 1;
pc⇩2 = pc⇩1 + size(compE⇩2 e⇩1) + 1
in compxE⇩2 e pc d @ compxE⇩2 e⇩1 pc⇩1 d @ compxE⇩2 e⇩2 pc⇩2 d)"
| "compxE⇩2 (while (b) e) pc d =
compxE⇩2 b pc d @ compxE⇩2 e (pc+size(compE⇩2 b)+1) d"
| "compxE⇩2 (throw e) pc d = compxE⇩2 e pc d"
| "compxE⇩2 (try e⇩1 catch(C i) e⇩2) pc d =
(let pc⇩1 = pc + size(compE⇩2 e⇩1)
in compxE⇩2 e⇩1 pc d @ compxE⇩2 e⇩2 (pc⇩1+2) d @ [(pc,pc⇩1,C,pc⇩1+1,d)])"
| "compxE⇩2 (INIT C (Cs, b) ← e) pc d = []"
| "compxE⇩2 (RI(C, e);Cs ← e') pc d = []"
| "compxEs⇩2 [] pc d = []"
| "compxEs⇩2 (e#es) pc d = compxE⇩2 e pc d @ compxEs⇩2 es (pc+size(compE⇩2 e)) (d+1)"
primrec max_stack :: "expr⇩1 ⇒ nat"
and max_stacks :: "expr⇩1 list ⇒ nat" where
"max_stack (new C) = 1"
| "max_stack (Cast C e) = max_stack e"
| "max_stack (Val v) = 1"
| "max_stack (e⇩1 «bop» e⇩2) = max (max_stack e⇩1) (max_stack e⇩2) + 1"
| "max_stack (Var i) = 1"
| "max_stack (i:=e) = max_stack e"
| "max_stack (e∙F{D}) = max_stack e"
| "max_stack (C∙⇩sF{D}) = 1"
| "max_stack (e⇩1∙F{D} := e⇩2) = max (max_stack e⇩1) (max_stack e⇩2) + 1"
| "max_stack (C∙⇩sF{D} := e⇩2) = max_stack e⇩2"
| "max_stack (e∙M(es)) = max (max_stack e) (max_stacks es) + 1"
| "max_stack (C∙⇩sM(es)) = max_stacks es + 1"
| "max_stack ({i:T; e}) = max_stack e"
| "max_stack (e⇩1;;e⇩2) = max (max_stack e⇩1) (max_stack e⇩2)"
| "max_stack (if (e) e⇩1 else e⇩2) =
max (max_stack e) (max (max_stack e⇩1) (max_stack e⇩2))"
| "max_stack (while (e) c) = max (max_stack e) (max_stack c)"
| "max_stack (throw e) = max_stack e"
| "max_stack (try e⇩1 catch(C i) e⇩2) = max (max_stack e⇩1) (max_stack e⇩2)"
| "max_stacks [] = 0"
| "max_stacks (e#es) = max (max_stack e) (1 + max_stacks es)"
lemma max_stack1': "¬sub_RI e ⟹ 1 ≤ max_stack e"
by(induct e) (simp_all add:max_def)
lemma compE⇩2_not_Nil': "¬sub_RI e ⟹ compE⇩2 e ≠ []"
by(induct e) auto
lemma compE⇩2_nRet: "⋀i. i ∈ set (compE⇩2 e⇩1) ⟹ i ≠ Return"
and "⋀i. i ∈ set (compEs⇩2 es⇩1) ⟹ i ≠ Return"
by(induct rule: compE⇩2.induct compEs⇩2.induct, auto simp: nth_append split: bop.splits)
definition compMb⇩2 :: "staticb ⇒ expr⇩1 ⇒ jvm_method"
where
"compMb⇩2 ≡ λb body.
let ins = compE⇩2 body @ [Return];
xt = compxE⇩2 body 0 0
in (max_stack body, max_vars body, ins, xt)"
definition compP⇩2 :: "J⇩1_prog ⇒ jvm_prog"
where
"compP⇩2 ≡ compP compMb⇩2"
declare compP⇩2_def [simp]
lemma compMb⇩2 [simp]:
"compMb⇩2 b e = (max_stack e, max_vars e,
compE⇩2 e @ [Return], compxE⇩2 e 0 0)"
by (simp add: compMb⇩2_def)
end
Theory Correctness2
section ‹ Correctness of Stage 2 ›
theory Correctness2
imports "HOL-Library.Sublist" Compiler2 J1WellForm "../J/EConform"
begin
hide_const (open) Throw
subsection‹ Instruction sequences ›
text‹ How to select individual instructions and subsequences of
instructions from a program given the class, method and program
counter. ›
definition before :: "jvm_prog ⇒ cname ⇒ mname ⇒ nat ⇒ instr list ⇒ bool"
("(_,_,_,_/ ⊳ _)" [51,0,0,0,51] 50) where
"P,C,M,pc ⊳ is ⟷ prefix is (drop pc (instrs_of P C M))"
definition at :: "jvm_prog ⇒ cname ⇒ mname ⇒ nat ⇒ instr ⇒ bool"
("(_,_,_,_/ ▹ _)" [51,0,0,0,51] 50) where
"P,C,M,pc ▹ i ⟷ (∃is. drop pc (instrs_of P C M) = i#is)"
lemma [simp]: "P,C,M,pc ⊳ []"
by(simp add:before_def)
lemma [simp]: "P,C,M,pc ⊳ (i#is) = (P,C,M,pc ▹ i ∧ P,C,M,pc + 1 ⊳ is)"
by(fastforce simp add:before_def at_def prefix_def drop_Suc drop_tl)
declare drop_drop[simp del]
lemma [simp]: "P,C,M,pc ⊳ (is⇩1 @ is⇩2) = (P,C,M,pc ⊳ is⇩1 ∧ P,C,M,pc + size is⇩1 ⊳ is⇩2)"
apply(simp add:before_def prefix_def)
apply(subst add.commute)
apply(simp add: drop_drop[symmetric])
apply fastforce
done
declare drop_drop[simp]
lemma [simp]: "P,C,M,pc ▹ i ⟹ instrs_of P C M ! pc = i"
by(clarsimp simp add:at_def strict_prefix_def nth_via_drop)
lemma beforeM:
"P ⊢ C sees M,b: Ts→T = body in D ⟹
compP⇩2 P,D,M,0 ⊳ compE⇩2 body @ [Return]"
apply(drule sees_method_idemp)
apply(simp add:before_def compP⇩2_def compMb⇩2_def)
done
text‹ This lemma executes a single instruction by rewriting: ›
lemma [simp]:
"P,C,M,pc ▹ instr ⟹
(P ⊢ (None, h, (vs,ls,C,M,pc,ics) # frs, sh) -jvm→ σ') =
((None, h, (vs,ls,C,M,pc,ics) # frs, sh) = σ' ∨
(∃σ. exec(P,(None, h, (vs,ls,C,M,pc,ics) # frs, sh)) = Some σ ∧ P ⊢ σ -jvm→ σ'))"
apply(simp only: exec_all_def)
apply(blast intro: converse_rtranclE converse_rtrancl_into_rtrancl)
done
subsection‹ Exception tables ›
definition pcs :: "ex_table ⇒ nat set"
where
"pcs xt ≡ ⋃(f,t,C,h,d) ∈ set xt. {f ..< t}"
lemma pcs_subset:
shows "(⋀pc d. pcs(compxE⇩2 e pc d) ⊆ {pc..<pc+size(compE⇩2 e)})"
and "(⋀pc d. pcs(compxEs⇩2 es pc d) ⊆ {pc..<pc+size(compEs⇩2 es)})"
apply(induct e and es rule: compxE⇩2.induct compxEs⇩2.induct)
apply (simp_all add:pcs_def)
apply (fastforce split:bop.splits)+
done
lemma [simp]: "pcs [] = {}"
by(simp add:pcs_def)
lemma [simp]: "pcs (x#xt) = {fst x ..< fst(snd x)} ∪ pcs xt"
by(auto simp add: pcs_def)
lemma [simp]: "pcs(xt⇩1 @ xt⇩2) = pcs xt⇩1 ∪ pcs xt⇩2"
by(simp add:pcs_def)
lemma [simp]: "pc < pc⇩0 ∨ pc⇩0+size(compE⇩2 e) ≤ pc ⟹ pc ∉ pcs(compxE⇩2 e pc⇩0 d)"
using pcs_subset by fastforce
lemma [simp]: "pc < pc⇩0 ∨ pc⇩0+size(compEs⇩2 es) ≤ pc ⟹ pc ∉ pcs(compxEs⇩2 es pc⇩0 d)"
using pcs_subset by fastforce
lemma [simp]: "pc⇩1 + size(compE⇩2 e⇩1) ≤ pc⇩2 ⟹ pcs(compxE⇩2 e⇩1 pc⇩1 d⇩1) ∩ pcs(compxE⇩2 e⇩2 pc⇩2 d⇩2) = {}"
using pcs_subset by fastforce
lemma [simp]: "pc⇩1 + size(compE⇩2 e) ≤ pc⇩2 ⟹ pcs(compxE⇩2 e pc⇩1 d⇩1) ∩ pcs(compxEs⇩2 es pc⇩2 d⇩2) = {}"
using pcs_subset by fastforce
lemma [simp]:
"pc ∉ pcs xt⇩0 ⟹ match_ex_table P C pc (xt⇩0 @ xt⇩1) = match_ex_table P C pc xt⇩1"
by (induct xt⇩0) (auto simp: matches_ex_entry_def)
lemma [simp]: "⟦ x ∈ set xt; pc ∉ pcs xt ⟧ ⟹ ¬ matches_ex_entry P D pc x"
by(auto simp:matches_ex_entry_def pcs_def)
lemma [simp]:
assumes xe: "xe ∈ set(compxE⇩2 e pc d)" and outside: "pc' < pc ∨ pc+size(compE⇩2 e) ≤ pc'"
shows "¬ matches_ex_entry P C pc' xe"
proof
assume "matches_ex_entry P C pc' xe"
with xe have "pc' ∈ pcs(compxE⇩2 e pc d)"
by(force simp add:matches_ex_entry_def pcs_def)
with outside show False by simp
qed
lemma [simp]:
assumes xe: "xe ∈ set(compxEs⇩2 es pc d)" and outside: "pc' < pc ∨ pc+size(compEs⇩2 es) ≤ pc'"
shows "¬ matches_ex_entry P C pc' xe"
proof
assume "matches_ex_entry P C pc' xe"
with xe have "pc' ∈ pcs(compxEs⇩2 es pc d)"
by(force simp add:matches_ex_entry_def pcs_def)
with outside show False by simp
qed
lemma match_ex_table_app[simp]:
"∀xte ∈ set xt⇩1. ¬ matches_ex_entry P D pc xte ⟹
match_ex_table P D pc (xt⇩1 @ xt) = match_ex_table P D pc xt"
by(induct xt⇩1) simp_all
lemma [simp]:
"∀x ∈ set xtab. ¬ matches_ex_entry P C pc x ⟹
match_ex_table P C pc xtab = None"
using match_ex_table_app[where ?xt = "[]"] by fastforce
lemma match_ex_entry:
"matches_ex_entry P C pc (start, end, catch_type, handler) =
(start ≤ pc ∧ pc < end ∧ P ⊢ C ≼⇧* catch_type)"
by(simp add:matches_ex_entry_def)
definition caught :: "jvm_prog ⇒ pc ⇒ heap ⇒ addr ⇒ ex_table ⇒ bool" where
"caught P pc h a xt ⟷
(∃entry ∈ set xt. matches_ex_entry P (cname_of h a) pc entry)"
definition beforex :: "jvm_prog ⇒ cname ⇒ mname ⇒ ex_table ⇒ nat set ⇒ nat ⇒ bool"
("(2_,/_,/_ ⊳/ _ /'/ _,/_)" [51,0,0,0,0,51] 50) where
"P,C,M ⊳ xt / I,d ⟷
(∃xt⇩0 xt⇩1. ex_table_of P C M = xt⇩0 @ xt @ xt⇩1 ∧ pcs xt⇩0 ∩ I = {} ∧ pcs xt ⊆ I ∧
(∀pc ∈ I. ∀C pc' d'. match_ex_table P C pc xt⇩1 = ⌊(pc',d')⌋ ⟶ d' ≤ d))"
definition dummyx :: "jvm_prog ⇒ cname ⇒ mname ⇒ ex_table ⇒ nat set ⇒ nat ⇒ bool" ("(2_,_,_ ▹/ _ '/_,_)" [51,0,0,0,0,51] 50) where
"P,C,M ▹ xt/I,d ⟷ P,C,M ⊳ xt/I,d"
lemma beforexD1: "P,C,M ⊳ xt / I,d ⟹ pcs xt ⊆ I"
by(auto simp add:beforex_def)
lemma beforex_mono: "⟦ P,C,M ⊳ xt/I,d'; d' ≤ d ⟧ ⟹ P,C,M ⊳ xt/I,d"
by(fastforce simp:beforex_def)
lemma [simp]: "P,C,M ⊳ xt/I,d ⟹ P,C,M ⊳ xt/I,Suc d"
by(fastforce intro:beforex_mono)
lemma beforex_append[simp]:
"pcs xt⇩1 ∩ pcs xt⇩2 = {} ⟹
P,C,M ⊳ xt⇩1 @ xt⇩2/I,d =
(P,C,M ⊳ xt⇩1/I-pcs xt⇩2,d ∧ P,C,M ⊳ xt⇩2/I-pcs xt⇩1,d ∧ P,C,M ▹ xt⇩1@xt⇩2/I,d)"
apply(rule iffI)
prefer 2
apply(simp add:dummyx_def)
apply(auto simp add: beforex_def dummyx_def)
apply(rule_tac x = xt⇩0 in exI)
apply auto
apply(rule_tac x = "xt⇩0@xt⇩1" in exI)
apply auto
done
lemma beforex_appendD1:
"⟦ P,C,M ⊳ xt⇩1 @ xt⇩2 @ [(f,t,D,h,d)] / I,d;
pcs xt⇩1 ⊆ J; J ⊆ I; J ∩ pcs xt⇩2 = {} ⟧
⟹ P,C,M ⊳ xt⇩1 / J,d"
apply(auto simp:beforex_def)
apply(rule exI,rule exI,rule conjI, rule refl)
apply(rule conjI, blast)
apply(auto)
apply(subgoal_tac "pc ∉ pcs xt⇩2")
prefer 2 apply blast
apply (auto split:if_split_asm)
done
lemma beforex_appendD2:
"⟦ P,C,M ⊳ xt⇩1 @ xt⇩2 @ [(f,t,D,h,d)] / I,d;
pcs xt⇩2 ⊆ J; J ⊆ I; J ∩ pcs xt⇩1 = {} ⟧
⟹ P,C,M ⊳ xt⇩2 / J,d"
apply(auto simp:beforex_def)
apply(rule_tac x = "xt⇩0 @ xt⇩1" in exI)
apply fastforce
done
lemma beforexM:
"P ⊢ C sees M,b: Ts→T = body in D ⟹ compP⇩2 P,D,M ⊳ compxE⇩2 body 0 0/{..<size(compE⇩2 body)},0"
apply(drule sees_method_idemp)
apply(drule sees_method_compP[where f = compMb⇩2])
apply(simp add:beforex_def compP⇩2_def compMb⇩2_def)
apply(rule_tac x = "[]" in exI)
using pcs_subset apply fastforce
done
lemma match_ex_table_SomeD2:
"⟦ match_ex_table P D pc (ex_table_of P C M) = ⌊(pc',d')⌋;
P,C,M ⊳ xt/I,d; ∀x ∈ set xt. ¬ matches_ex_entry P D pc x; pc ∈ I ⟧
⟹ d' ≤ d"
apply(auto simp:beforex_def)
apply(subgoal_tac "pc ∉ pcs xt⇩0")
apply auto
done
lemma match_ex_table_SomeD1:
"⟦ match_ex_table P D pc (ex_table_of P C M) = ⌊(pc',d')⌋;
P,C,M ⊳ xt / I,d; pc ∈ I; pc ∉ pcs xt ⟧ ⟹ d' ≤ d"
by(auto elim: match_ex_table_SomeD2)
subsection‹ The correctness proof ›
declare nat_add_distrib[simp] caught_def[simp]
declare fun_upd_apply[simp del]
definition
handle :: "jvm_prog ⇒ cname ⇒ mname ⇒ addr ⇒ heap ⇒ val list ⇒ val list ⇒ nat ⇒ init_call_status ⇒ frame list ⇒ sheap
⇒ jvm_state" where
"handle P C M a h vs ls pc ics frs sh = find_handler P a h ((vs,ls,C,M,pc,ics) # frs) sh"
lemma aux_isin[simp]: "⟦ B ⊆ A; a ∈ B ⟧ ⟹ a ∈ A"
by blast
lemma handle_frs_tl_neq:
"ics_of f ≠ No_ics
⟹ (xp, h, f#frs, sh) ≠ handle P C M xa h' vs l pc ics frs sh'"
by(simp add: handle_def find_handler_frs_tl_neq del: find_handler.simps)
subsubsection "Correctness proof inductive hypothesis"
fun calling_to_called :: "frame ⇒ frame" where
"calling_to_called (stk,loc,D,M,pc,ics) = (stk,loc,D,M,pc,case ics of Calling C Cs ⇒ Called (C#Cs))"
fun calling_to_scalled :: "frame ⇒ frame" where
"calling_to_scalled (stk,loc,D,M,pc,ics) = (stk,loc,D,M,pc,case ics of Calling C Cs ⇒ Called Cs)"
fun calling_to_calling :: "frame ⇒ cname ⇒ frame" where
"calling_to_calling (stk,loc,D,M,pc,ics) C' = (stk,loc,D,M,pc,case ics of Calling C Cs ⇒ Calling C' (C#Cs))"
fun calling_to_throwing :: "frame ⇒ addr ⇒ frame" where
"calling_to_throwing (stk,loc,D,M,pc,ics) a = (stk,loc,D,M,pc,case ics of Calling C Cs ⇒ Throwing (C#Cs) a)"
fun calling_to_sthrowing :: "frame ⇒ addr ⇒ frame" where
"calling_to_sthrowing (stk,loc,D,M,pc,ics) a = (stk,loc,D,M,pc,case ics of Calling C Cs ⇒ Throwing Cs a)"
fun Jcc_cond :: "J⇩1_prog ⇒ ty list ⇒ cname ⇒ mname ⇒ val list ⇒ pc ⇒ init_call_status
⇒ nat set ⇒ heap ⇒ sheap ⇒ expr⇩1 ⇒ bool" where
"Jcc_cond P E C M vs pc ics I h sh (INIT C⇩0 (Cs,b) ← e')
= ((∃T. P,E,h,sh ⊢⇩1 INIT C⇩0 (Cs,b) ← e' : T) ∧ unit = e' ∧ ics = No_ics)" |
"Jcc_cond P E C M vs pc ics I h sh (RI(C',e⇩0);Cs ← e')
= (((e⇩0 = C'∙⇩sclinit([]) ∧ (∃T. P,E,h,sh ⊢⇩1 RI(C',e⇩0);Cs ← e':T))
∨ ((∃a. e⇩0 = Throw a) ∧ (∀C ∈ set(C'#Cs). is_class P C)))
∧ unit = e' ∧ ics = No_ics)" |
"Jcc_cond P E C M vs pc ics I h sh (C'∙⇩sM'(es))
= (let e = (C'∙⇩sM'(es))
in if M' = clinit ∧ es = [] then (∃T. P,E,h,sh ⊢⇩1 e:T) ∧ (∃Cs. ics = Called Cs)
else (compP⇩2 P,C,M,pc ⊳ compE⇩2 e ∧ compP⇩2 P,C,M ⊳ compxE⇩2 e pc (size vs)/I,size vs
∧ {pc..<pc+size(compE⇩2 e)} ⊆ I ∧ ¬sub_RI e ∧ ics = No_ics)
)" |
"Jcc_cond P E C M vs pc ics I h sh e
= (compP⇩2 P,C,M,pc ⊳ compE⇩2 e ∧ compP⇩2 P,C,M ⊳ compxE⇩2 e pc (size vs)/I,size vs
∧ {pc..<pc+size(compE⇩2 e)} ⊆ I ∧ ¬sub_RI e ∧ ics = No_ics)"
fun Jcc_frames :: "jvm_prog ⇒ cname ⇒ mname ⇒ val list ⇒ val list ⇒ pc ⇒ init_call_status
⇒ frame list ⇒ expr⇩1 ⇒ frame list" where
"Jcc_frames P C M vs ls pc ics frs (INIT C⇩0 (C'#Cs,b) ← e')
= (case b of False ⇒ (vs,ls,C,M,pc,Calling C' Cs) # frs
| True ⇒ (vs,ls,C,M,pc,Called (C'#Cs)) # frs
)" |
"Jcc_frames P C M vs ls pc ics frs (INIT C⇩0 (Nil,b) ← e')
= (vs,ls,C,M,pc,Called [])#frs" |
"Jcc_frames P C M vs ls pc ics frs (RI(C',e⇩0);Cs ← e')
= (case e⇩0 of Throw a ⇒ (vs,ls,C,M,pc,Throwing (C'#Cs) a) # frs
| _ ⇒ (vs,ls,C,M,pc,Called (C'#Cs)) # frs )" |
"Jcc_frames P C M vs ls pc ics frs (C'∙⇩sM'(es))
= (if M' = clinit ∧ es = []
then create_init_frame P C'#(vs,ls,C,M,pc,ics)#frs
else (vs,ls,C,M,pc,ics)#frs
)" |
"Jcc_frames P C M vs ls pc ics frs e
= (vs,ls,C,M,pc,ics)#frs"
fun Jcc_rhs :: "J⇩1_prog ⇒ ty list ⇒ cname ⇒ mname ⇒ val list ⇒ val list ⇒ pc ⇒ init_call_status
⇒ frame list ⇒ heap ⇒ val list ⇒ sheap ⇒ val ⇒ expr⇩1 ⇒ jvm_state" where
"Jcc_rhs P E C M vs ls pc ics frs h' ls' sh' v (INIT C⇩0 (Cs,b) ← e')
= (None,h',(vs,ls,C,M,pc,Called [])#frs,sh')" |
"Jcc_rhs P E C M vs ls pc ics frs h' ls' sh' v (RI(C',e⇩0);Cs ← e')
= (None,h',(vs,ls,C,M,pc,Called [])#frs,sh')" |
"Jcc_rhs P E C M vs ls pc ics frs h' ls' sh' v (C'∙⇩sM'(es))
= (let e = (C'∙⇩sM'(es))
in if M' = clinit ∧ es = []
then (None,h',(vs,ls,C,M,pc,ics)#frs,sh'(C'↦(fst(the(sh' C')),Done)))
else (None,h',(v#vs,ls',C,M,pc+size(compE⇩2 e),ics)#frs,sh')
)" |
"Jcc_rhs P E C M vs ls pc ics frs h' ls' sh' v e
= (None,h',(v#vs,ls',C,M,pc+size(compE⇩2 e),ics)#frs,sh')"
fun Jcc_err :: "jvm_prog ⇒ cname ⇒ mname ⇒ heap ⇒ val list ⇒ val list ⇒ pc ⇒ init_call_status
⇒ frame list ⇒ sheap ⇒ nat set ⇒ heap ⇒ val list ⇒ sheap ⇒ addr ⇒ expr⇩1
⇒ bool" where
"Jcc_err P C M h vs ls pc ics frs sh I h' ls' sh' xa (INIT C⇩0 (Cs,b) ← e')
= (∃vs'. P ⊢ (None,h,Jcc_frames P C M vs ls pc ics frs (INIT C⇩0 (Cs,b) ← e'),sh)
-jvm→ handle P C M xa h' (vs'@vs) ls pc ics frs sh')" |
"Jcc_err P C M h vs ls pc ics frs sh I h' ls' sh' xa (RI(C',e⇩0);Cs ← e')
= (∃vs'. P ⊢ (None,h,Jcc_frames P C M vs ls pc ics frs (RI(C',e⇩0);Cs ← e'),sh)
-jvm→ handle P C M xa h' (vs'@vs) ls pc ics frs sh')" |
"Jcc_err P C M h vs ls pc ics frs sh I h' ls' sh' xa (C'∙⇩sM'(es))
= (let e = (C'∙⇩sM'(es))
in if M' = clinit ∧ es = []
then case ics of
Called Cs ⇒ P ⊢ (None,h,Jcc_frames P C M vs ls pc ics frs e,sh)
-jvm→ (None,h',(vs,ls,C,M,pc,Throwing Cs xa)#frs,(sh'(C' ↦ (fst(the(sh' C')),Error))))
else (∃pc⇩1. pc ≤ pc⇩1 ∧ pc⇩1 < pc + size(compE⇩2 e) ∧
¬ caught P pc⇩1 h' xa (compxE⇩2 e pc (size vs)) ∧
(∃vs'. P ⊢ (None,h,Jcc_frames P C M vs ls pc ics frs e,sh)
-jvm→ handle P C M xa h' (vs'@vs) ls' pc⇩1 ics frs sh'))
)" |
"Jcc_err P C M h vs ls pc ics frs sh I h' ls' sh' xa e
= (∃pc⇩1. pc ≤ pc⇩1 ∧ pc⇩1 < pc + size(compE⇩2 e) ∧
¬ caught P pc⇩1 h' xa (compxE⇩2 e pc (size vs)) ∧
(∃vs'. P ⊢ (None,h,Jcc_frames P C M vs ls pc ics frs e,sh)
-jvm→ handle P C M xa h' (vs'@vs) ls' pc⇩1 ics frs sh'))"
fun Jcc_pieces :: "J⇩1_prog ⇒ ty list ⇒ cname ⇒ mname ⇒ heap ⇒ val list ⇒ val list ⇒ pc ⇒ init_call_status
⇒ frame list ⇒ sheap ⇒ nat set ⇒ heap ⇒ val list ⇒ sheap ⇒ val ⇒ addr ⇒ expr⇩1
⇒ bool × frame list × jvm_state × bool" where
"Jcc_pieces P E C M h vs ls pc ics frs sh I h' ls' sh' v xa e
= (Jcc_cond P E C M vs pc ics I h sh e, Jcc_frames (compP⇩2 P) C M vs ls pc ics frs e,
Jcc_rhs P E C M vs ls pc ics frs h' ls' sh' v e,
Jcc_err (compP⇩2 P) C M h vs ls pc ics frs sh I h' ls' sh' xa e)"
lemma nsub_RI_Jcc_pieces:
assumes [simp]: "P ≡ compP⇩2 P⇩1"
and nsub: "¬sub_RI e"
shows "Jcc_pieces P⇩1 E C M h vs ls pc ics frs sh I h' ls' sh' v xa e
= (let cond = P,C,M,pc ⊳ compE⇩2 e ∧ P,C,M ⊳ compxE⇩2 e pc (size vs)/I,size vs
∧ {pc..<pc+size(compE⇩2 e)} ⊆ I ∧ ics = No_ics;
frs' = (vs,ls,C,M,pc,ics)#frs;
rhs = (None,h',(v#vs,ls',C,M,pc+size(compE⇩2 e),ics)#frs,sh');
err = (∃pc⇩1. pc ≤ pc⇩1 ∧ pc⇩1 < pc + size(compE⇩2 e) ∧
¬ caught P pc⇩1 h' xa (compxE⇩2 e pc (size vs)) ∧
(∃vs'. P ⊢ (None,h,frs',sh) -jvm→ handle P C M xa h' (vs'@vs) ls' pc⇩1 ics frs sh'))
in (cond, frs',rhs, err)
)"
proof -
have NC: "∀C'. e ≠ C'∙⇩sclinit([])" using assms(2) proof(cases e) qed(simp_all)
then show ?thesis using assms
proof(cases e)
case (SCall C M es)
then have "M ≠ clinit" using nsub by simp
then show ?thesis using SCall nsub proof(cases es) qed(simp_all)
qed(simp_all)
qed
lemma Jcc_pieces_Cast:
assumes [simp]: "P ≡ compP⇩2 P⇩1"
and "Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩1 ls⇩1 sh⇩1 v xa (Cast C' e)
= (True, frs⇩0, (xp',h',(v#vs',ls',C⇩0,M',pc',ics')#frs',sh'), err)"
shows "Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩1 ls⇩1 sh⇩1 v' xa e
= (True, frs⇩0, (xp',h',(v'#vs',ls',C⇩0,M',pc' - 1,ics')#frs',sh'),
(∃pc⇩1. pc ≤ pc⇩1 ∧ pc⇩1 < pc + size(compE⇩2 e) ∧
¬ caught P pc⇩1 h⇩1 xa (compxE⇩2 e pc (size vs)) ∧
(∃vs'. P ⊢ (None,h⇩0,frs⇩0,sh⇩0) -jvm→ handle P C M xa h⇩1 (vs'@vs) ls⇩1 pc⇩1 ics frs sh⇩1)))"
proof -
have pc: "{pc..<pc + length (compE⇩2 e)} ⊆ I" using assms by clarsimp
show ?thesis using assms nsub_RI_Jcc_pieces[where e=e] pc by clarsimp
qed
lemma Jcc_pieces_BinOp1:
assumes
"Jcc_pieces P E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩2 ls⇩2 sh⇩2 v xa (e «bop» e')
= (True, frs⇩0, (xp',h',(v#vs',ls',C⇩0,M',pc',ics')#frs',sh'), err)"
shows "∃err. Jcc_pieces P E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0
(I - pcs (compxE⇩2 e' (pc + length (compE⇩2 e)) (Suc (length vs')))) h⇩1 ls⇩1 sh⇩1 v' xa e
= (True, frs⇩0, (xp',h⇩1,(v'#vs',ls⇩1,C⇩0,M',pc' - size (compE⇩2 e') - 1,ics')#frs',sh⇩1), err)"
proof -
have bef: "compP compMb⇩2 P,C⇩0,M' ⊳ compxE⇩2 e pc (length vs)
/ I - pcs (compxE⇩2 e' (pc + length (compE⇩2 e)) (Suc (length vs'))),length vs"
using assms by clarsimp
have vs: "vs = vs'" using assms by simp
show ?thesis using assms nsub_RI_Jcc_pieces[where e=e] bef vs by clarsimp
qed
lemma Jcc_pieces_BinOp2:
assumes [simp]: "P ≡ compP⇩2 P⇩1"
and "Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩2 ls⇩2 sh⇩2 v xa (e «bop» e')
= (True, frs⇩0, (xp',h',(v#vs',ls',C⇩0,M',pc',ics')#frs',sh'), err)"
shows "∃err. Jcc_pieces P⇩1 E C M h⇩1 (v⇩1#vs) ls⇩1 (pc + size (compE⇩2 e)) ics frs sh⇩1
(I - pcs (compxE⇩2 e pc (length vs'))) h⇩2 ls⇩2 sh⇩2 v' xa e'
= (True, (v⇩1#vs,ls⇩1,C,M,pc + size (compE⇩2 e),ics)#frs,
(xp',h',(v'#v⇩1#vs',ls',C⇩0,M',pc' - 1,ics')#frs',sh'),
(∃pc⇩1. pc + size (compE⇩2 e) ≤ pc⇩1 ∧ pc⇩1 < pc + size (compE⇩2 e) + length (compE⇩2 e') ∧
¬ caught P pc⇩1 h⇩2 xa (compxE⇩2 e' (pc + size (compE⇩2 e)) (Suc (length vs))) ∧
(∃vs'. P ⊢ (None,h⇩1,(v⇩1#vs,ls⇩1,C,M,pc + size (compE⇩2 e),ics)#frs,sh⇩1)
-jvm→ handle P C M xa h⇩2 (vs'@v⇩1#vs) ls⇩2 pc⇩1 ics frs sh⇩2)))"
proof -
have bef: "compP compMb⇩2 P⇩1,C⇩0,M' ⊳ compxE⇩2 e pc (length vs)
/ I - pcs (compxE⇩2 e' (pc + length (compE⇩2 e)) (Suc (length vs'))),length vs"
using assms by clarsimp
have vs: "vs = vs'" using assms by simp
show ?thesis using assms nsub_RI_Jcc_pieces[where e=e'] bef vs by clarsimp
qed
lemma Jcc_pieces_FAcc:
assumes
"Jcc_pieces P E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩1 ls⇩1 sh⇩1 v xa (e∙F{D})
= (True, frs⇩0, (xp',h',(v#vs',ls',C⇩0,M',pc',ics')#frs',sh'), err)"
shows "∃err. Jcc_pieces P E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩1 ls⇩1 sh⇩1 v' xa e
= (True, frs⇩0, (xp',h',(v'#vs',ls',C⇩0,M',pc' - 1,ics')#frs',sh'), err)"
proof -
have pc: "{pc..<pc + length (compE⇩2 e)} ⊆ I" using assms by clarsimp
then show ?thesis using assms nsub_RI_Jcc_pieces[where e=e] by clarsimp
qed
lemma Jcc_pieces_LAss:
assumes [simp]: "P ≡ compP⇩2 P⇩1"
and "Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩1 ls⇩1 sh⇩1 v xa (i:=e)
= (True, frs⇩0, (xp',h',(v#vs',ls',C⇩0,M',pc',ics')#frs',sh'), err)"
shows "Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩1 ls⇩1 sh⇩1 v' xa e
= (True, frs⇩0, (xp',h',(v'#vs',ls',C⇩0,M',pc' - 2,ics')#frs',sh'),
(∃pc⇩1. pc ≤ pc⇩1 ∧ pc⇩1 < pc + size(compE⇩2 e) ∧
¬ caught P pc⇩1 h⇩1 xa (compxE⇩2 e pc (size vs)) ∧
(∃vs'. P ⊢ (None,h⇩0,frs⇩0,sh⇩0) -jvm→ handle P C M xa h⇩1 (vs'@vs) ls⇩1 pc⇩1 ics frs sh⇩1)))"
proof -
have pc: "{pc..<pc + length (compE⇩2 e)} ⊆ I" using assms by clarsimp
show ?thesis using assms nsub_RI_Jcc_pieces[where e=e] pc by clarsimp
qed
lemma Jcc_pieces_FAss1:
assumes
"Jcc_pieces P E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩2 ls⇩2 sh⇩2 v xa (e∙F{D}:=e')
= (True, frs⇩0, (xp',h',(v#vs',ls',C⇩0,M',pc',ics')#frs',sh'), err)"
shows "∃err. Jcc_pieces P E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0
(I - pcs (compxE⇩2 e' (pc + length (compE⇩2 e)) (Suc (length vs')))) h⇩1 ls⇩1 sh⇩1 v' xa e
= (True, frs⇩0, (xp',h⇩1,(v'#vs',ls⇩1,C⇩0,M',pc' - size (compE⇩2 e') - 2,ics')#frs',sh⇩1), err)"
proof -
show ?thesis using assms nsub_RI_Jcc_pieces[where e=e] by clarsimp
qed
lemma Jcc_pieces_FAss2:
assumes
"Jcc_pieces P E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩2 ls⇩2 sh⇩2 v xa (e∙F{D}:=e')
= (True, frs⇩0, (xp',h',(v#vs',ls',C⇩0,M',pc',ics')#frs',sh'), err)"
shows "Jcc_pieces P E C M h⇩1 (v⇩1#vs) ls⇩1 (pc + size (compE⇩2 e)) ics frs sh⇩1
(I - pcs (compxE⇩2 e pc (length vs'))) h⇩2 ls⇩2 sh⇩2 v' xa e'
= (True, (v⇩1#vs,ls⇩1,C,M,pc + size (compE⇩2 e),ics)#frs,
(xp',h',(v'#v⇩1#vs',ls',C⇩0,M',pc' - 2,ics')#frs',sh'),
(∃pc⇩1. (pc + size (compE⇩2 e)) ≤ pc⇩1 ∧ pc⇩1 < pc + size (compE⇩2 e) + size(compE⇩2 e') ∧
¬ caught (compP⇩2 P) pc⇩1 h⇩2 xa (compxE⇩2 e' (pc + size (compE⇩2 e)) (size (v⇩1#vs))) ∧
(∃vs'. (compP⇩2 P) ⊢ (None,h⇩1,(v⇩1#vs,ls⇩1,C,M,pc + size (compE⇩2 e),ics)#frs,sh⇩1)
-jvm→ handle (compP⇩2 P) C M xa h⇩2 (vs'@v⇩1#vs) ls⇩2 pc⇩1 ics frs sh⇩2)))"
proof -
show ?thesis using assms nsub_RI_Jcc_pieces[where e=e'] by clarsimp
qed
lemma Jcc_pieces_SFAss:
assumes
"Jcc_pieces P E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h' ls' sh' v xa (C'∙⇩sF{D}:=e)
= (True, frs⇩0, (xp',h',(v#vs',ls',C⇩0,M',pc',ics')#frs',sh'), err)"
shows "∃err. Jcc_pieces P E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩1 ls⇩1 sh⇩1 v' xa e
= (True, frs⇩0, (xp',h⇩1,(v'#vs',ls⇩1,C⇩0,M',pc' - 2,ics')#frs',sh⇩1), err)"
proof -
have pc: "{pc..<pc + length (compE⇩2 e)} ⊆ I" using assms by clarsimp
show ?thesis using assms nsub_RI_Jcc_pieces[where e=e] pc by clarsimp
qed
lemma Jcc_pieces_Call1:
assumes
"Jcc_pieces P E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩3 ls⇩3 sh⇩3 v xa (e∙M⇩0(es))
= (True, frs⇩0, (xp',h',(v#vs',ls',C',M',pc',ics')#frs',sh'), err)"
shows "∃err. Jcc_pieces P E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0
(I - pcs (compxEs⇩2 es (pc + length (compE⇩2 e)) (Suc (length vs')))) h⇩1 ls⇩1 sh⇩1 v' xa e
= (True, frs⇩0,
(xp',h⇩1,(v'#vs',ls⇩1,C',M',pc' - size (compEs⇩2 es) - 1,ics')#frs',sh⇩1), err)"
proof -
show ?thesis using assms nsub_RI_Jcc_pieces[where e=e] by clarsimp
qed
lemma Jcc_pieces_clinit:
assumes [simp]: "P ≡ compP⇩2 P⇩1"
and cond: "Jcc_cond P⇩1 E C M vs pc ics I h sh (C1∙⇩sclinit([]))"
shows "Jcc_pieces P⇩1 E C M h vs ls pc ics frs sh I h' ls' sh' v xa (C1∙⇩sclinit([]))
= (True, create_init_frame P C1 # (vs,ls,C,M,pc,ics)#frs,
(None, h', (vs,ls,C,M,pc,ics)#frs, sh'(C1↦(fst(the(sh' C1)),Done))),
P ⊢ (None,h,create_init_frame P C1 # (vs,ls,C,M,pc,ics)#frs,sh) -jvm→
(case ics of Called Cs ⇒ (None,h',(vs,ls,C,M,pc,Throwing Cs xa)#frs,(sh'(C1 ↦ (fst(the(sh' C1)),Error))))))"
using assms by(auto split: init_call_status.splits list.splits bool.splits)
lemma Jcc_pieces_SCall_clinit_body:
assumes [simp]: "P ≡ compP⇩2 P⇩1" and wf: "wf_J⇩1_prog P⇩1"
and "Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩3 ls⇩2 sh⇩3 v xa (C1∙⇩sclinit([]))
= (True, frs', rhs', err')"
and method: "P⇩1 ⊢ C1 sees clinit,Static: []→Void = body in D"
shows "Jcc_pieces P⇩1 [] D clinit h⇩2 [] (replicate (max_vars body) undefined) 0
No_ics (tl frs') sh⇩2 {..<length (compE⇩2 body)} h⇩3 ls⇩3 sh⇩3 v xa body
= (True, frs',
(None,h⇩3,([v],ls⇩3,D,clinit,size(compE⇩2 body), No_ics)#tl frs',sh⇩3),
∃pc⇩1. 0 ≤ pc⇩1 ∧ pc⇩1 < size(compE⇩2 body) ∧
¬ caught P pc⇩1 h⇩3 xa (compxE⇩2 body 0 0) ∧
(∃vs'. P ⊢ (None,h⇩2,frs',sh⇩2) -jvm→ handle P D clinit xa h⇩3 vs' ls⇩3 pc⇩1
No_ics (tl frs') sh⇩3))"
proof -
have M_in_D: "P⇩1 ⊢ D sees clinit,Static: []→Void = body in D"
using method by(rule sees_method_idemp)
hence M_code: "compP⇩2 P⇩1,D,clinit,0 ⊳ compE⇩2 body @ [Return]"
and M_xtab: "compP⇩2 P⇩1,D,clinit ⊳ compxE⇩2 body 0 0/{..<size(compE⇩2 body)},0"
by(rule beforeM, rule beforexM)
have nsub: "¬sub_RI body" by(rule sees_wf⇩1_nsub_RI[OF wf method])
then show ?thesis using assms nsub_RI_Jcc_pieces M_code M_xtab by clarsimp
qed
lemma Jcc_pieces_Cons:
assumes [simp]: "P ≡ compP⇩2 P⇩1"
and "P,C,M,pc ⊳ compEs⇩2 (e#es)" and "P,C,M ⊳ compxEs⇩2 (e#es) pc (size vs)/I,size vs"
and "{pc..<pc+size(compEs⇩2 (e#es))} ⊆ I"
and "ics = No_ics"
and "¬sub_RIs (e#es)"
shows "Jcc_pieces P⇩1 E C M h vs ls pc ics frs sh
(I - pcs (compxEs⇩2 es (pc + length (compE⇩2 e)) (Suc (length vs)))) h' ls' sh' v xa e
= (True, (vs, ls, C, M, pc, ics) # frs,
(None, h', (v#vs, ls', C, M, pc + length (compE⇩2 e), ics) # frs, sh'),
∃pc⇩1≥pc. pc⇩1 < pc + length (compE⇩2 e) ∧ ¬ caught P pc⇩1 h' xa (compxE⇩2 e pc (length vs))
∧ (∃vs'. P ⊢ (None, h, (vs, ls, C, M, pc, ics) # frs, sh)
-jvm→ handle P C M xa h' (vs'@vs) ls' pc⇩1 ics frs sh'))"
proof -
show ?thesis using assms nsub_RI_Jcc_pieces[where e=e] by auto
qed
lemma Jcc_pieces_InitNone:
assumes [simp]: "P ≡ compP⇩2 P⇩1"
and "Jcc_pieces P⇩1 E C M h vs l pc ics frs sh I h' l' sh' v xa (INIT C' (C⇩0 # Cs,False) ← e)
= (True, frs', (None, h', (vs, l, C, M, pc, Called []) # frs, sh'), err)"
shows
"Jcc_pieces P⇩1 E C M h vs l pc ics frs (sh(C⇩0 ↦ (sblank P C⇩0, Prepared)))
I h' l' sh' v xa (INIT C' (C⇩0 # Cs,False) ← e)
= (True, frs', (None, h', (vs, l, C, M, pc, Called []) # frs, sh'),
∃vs'. P ⊢ (None,h,frs',(sh(C⇩0 ↦ (sblank P⇩1 C⇩0, Prepared))))
-jvm→ handle P C M xa h' (vs'@vs) l pc ics frs sh')"
proof -
have "Jcc_cond P⇩1 E C M vs pc ics I h sh (INIT C' (C⇩0 # Cs,False) ← e)" using assms by simp
then obtain T where "P⇩1,E,h,sh ⊢⇩1 INIT C' (C⇩0 # Cs,False) ← unit : T" by fastforce
then have "P⇩1,E,h,sh(C⇩0 ↦ (sblank P⇩1 C⇩0, Prepared)) ⊢⇩1 INIT C' (C⇩0 # Cs,False) ← unit : T"
by(auto simp: fun_upd_apply)
then have "Ex (WTrt2⇩1 P⇩1 E h (sh(C⇩0 ↦ (sblank P⇩1 C⇩0, Prepared))) (INIT C' (C⇩0 # Cs,False) ← unit))"
by(simp only: exI)
then show ?thesis using assms by clarsimp
qed
lemma Jcc_pieces_InitDP:
assumes [simp]: "P ≡ compP⇩2 P⇩1"
and "Jcc_pieces P⇩1 E C M h vs l pc ics frs sh I h' l' sh' v xa (INIT C' (C⇩0 # Cs,False) ← e)
= (True, frs', (None, h', (vs, l, C, M, pc, Called []) # frs, sh'), err)"
shows
"Jcc_pieces P⇩1 E C M h vs l pc ics frs sh I h' l' sh' v xa (INIT C' (Cs,True) ← e)
= (True, (calling_to_scalled (hd frs'))#(tl frs'),
(None, h', (vs, l, C, M, pc, Called []) # frs, sh'),
∃vs'. P ⊢ (None,h,calling_to_scalled (hd frs')#(tl frs'),sh)
-jvm→ handle P C M xa h' (vs'@vs) l pc ics frs sh')"
proof -
have "Jcc_cond P⇩1 E C M vs pc ics I h sh (INIT C' (C⇩0 # Cs,False) ← e)" using assms by simp
then obtain T where "P⇩1,E,h,sh ⊢⇩1 INIT C' (C⇩0 # Cs,False) ← unit : T" by fastforce
then have "P⇩1,E,h,sh ⊢⇩1 INIT C' (Cs,True) ← unit : T"
by (auto; metis list.sel(2) list.set_sel(2))
then have wtrt: "Ex (WTrt2⇩1 P⇩1 E h sh (INIT C' (Cs,True) ← unit))" by(simp only: exI)
show ?thesis using assms wtrt
proof(cases Cs)
case (Cons C1 Cs1)
then show ?thesis using assms wtrt
by(case_tac "method P C1 clinit") clarsimp
qed(clarsimp)
qed
lemma Jcc_pieces_InitError:
assumes [simp]: "P ≡ compP⇩2 P⇩1"
and "Jcc_pieces P⇩1 E C M h vs l pc ics frs sh I h' l' sh' v xa (INIT C' (C⇩0 # Cs,False) ← e)
= (True, frs', (None, h', (vs, l, C, M, pc, Called []) # frs, sh'), err)"
and err: "sh C⇩0 = Some(sfs,Error)"
shows
"Jcc_pieces P⇩1 E C M h vs l pc ics frs sh I h' l' sh' v xa (RI (C⇩0, THROW NoClassDefFoundError);Cs ← e)
= (True, (calling_to_throwing (hd frs') (addr_of_sys_xcpt NoClassDefFoundError))#(tl frs'),
(None, h', (vs, l, C, M, pc, Called []) # frs, sh'),
∃vs'. P ⊢ (None,h, (calling_to_throwing (hd frs') (addr_of_sys_xcpt NoClassDefFoundError))#(tl frs'),sh)
-jvm→ handle P C M xa h' (vs'@vs) l pc ics frs sh')"
proof -
show ?thesis using assms
proof(cases Cs)
case (Cons C1 Cs1)
then show ?thesis using assms
by(case_tac "method P C1 clinit", case_tac "method P C⇩0 clinit") clarsimp
qed(clarsimp)
qed
lemma Jcc_pieces_InitObj:
assumes [simp]: "P ≡ compP⇩2 P⇩1"
and "Jcc_pieces P⇩1 E C M h vs l pc ics frs sh I h' l' (sh(C⇩0 ↦ (sfs,Processing))) v xa (INIT C' (C⇩0 # Cs,False) ← e)
= (True, frs', (None, h', (vs, l, C, M, pc, Called []) # frs, sh'), err)"
shows
"Jcc_pieces P⇩1 E C M h vs l pc ics frs (sh(C⇩0 ↦ (sfs,Processing))) I h' l' sh'' v xa (INIT C' (C⇩0 # Cs,True) ← e)
= (True, calling_to_called (hd frs')#(tl frs'),
(None, h', (vs, l, C, M, pc, Called []) # frs, sh''),
∃vs'. P ⊢ (None,h,calling_to_called (hd frs')#(tl frs'),sh')
-jvm→ handle P C M xa h' (vs'@vs) l pc ics frs sh'')"
proof -
have "Jcc_cond P⇩1 E C M vs pc ics I h sh (INIT C' (C⇩0 # Cs,False) ← e)" using assms by simp
then obtain T where "P⇩1,E,h,sh ⊢⇩1 INIT C' (C⇩0 # Cs,False) ← unit : T" by fastforce
then have "P⇩1,E,h,sh(C⇩0 ↦ (sfs,Processing)) ⊢⇩1 INIT C' (C⇩0 # Cs,True) ← unit : T"
using assms by clarsimp (auto simp: fun_upd_apply)
then have wtrt: "Ex (WTrt2⇩1 P⇩1 E h (sh(C⇩0 ↦ (sfs,Processing))) (INIT C' (C⇩0 # Cs,True) ← unit))"
by(simp only: exI)
show ?thesis using assms wtrt by clarsimp
qed
lemma Jcc_pieces_InitNonObj:
assumes [simp]: "P ≡ compP⇩2 P⇩1"
and "is_class P⇩1 D" and "D ∉ set (C⇩0#Cs)" and "∀C ∈ set (C⇩0#Cs). P⇩1 ⊢ C ≼⇧* D"
and pcs: "Jcc_pieces P⇩1 E C M h vs l pc ics frs sh I h' l' (sh(C⇩0 ↦ (sfs,Processing))) v xa (INIT C' (C⇩0 # Cs,False) ← e)
= (True, frs', (None, h', (vs, l, C, M, pc, Called []) # frs, sh'), err)"
shows
"Jcc_pieces P⇩1 E C M h vs l pc ics frs (sh(C⇩0 ↦ (sfs,Processing))) I h' l' sh'' v xa (INIT C' (D # C⇩0 # Cs,False) ← e)
= (True, calling_to_calling (hd frs') D#(tl frs'),
(None, h', (vs, l, C, M, pc, Called []) # frs, sh''),
∃vs'. P ⊢ (None,h,calling_to_calling (hd frs') D#(tl frs'),sh')
-jvm→ handle P C M xa h' (vs'@vs) l pc ics frs sh'')"
proof -
have "Jcc_cond P⇩1 E C M vs pc ics I h sh (INIT C' (C⇩0 # Cs,False) ← e)" using assms by simp
then obtain T where "P⇩1,E,h,sh ⊢⇩1 INIT C' (C⇩0 # Cs,False) ← unit : T" by fastforce
then have "P⇩1,E,h,sh(C⇩0 ↦ (sfs,Processing)) ⊢⇩1 INIT C' (D # C⇩0 # Cs,False) ← unit : T"
using assms by clarsimp (auto simp: fun_upd_apply)
then have wtrt: "Ex (WTrt2⇩1 P⇩1 E h (sh(C⇩0 ↦ (sfs,Processing))) (INIT C' (D # C⇩0 # Cs,False) ← unit))"
by(simp only: exI)
show ?thesis using assms wtrt by clarsimp
qed
lemma Jcc_pieces_InitRInit:
assumes [simp]: "P ≡ compP⇩2 P⇩1" and wf: "wf_J⇩1_prog P⇩1"
and "Jcc_pieces P⇩1 E C M h vs l pc ics frs sh I h' l' sh' v xa (INIT C' (C⇩0 # Cs,True) ← e)
= (True, frs', (None, h', (vs, l, C, M, pc, Called []) # frs, sh'), err)"
shows
"Jcc_pieces P⇩1 E C M h vs l pc ics frs sh I h' l' sh' v xa (RI (C⇩0,C⇩0∙⇩sclinit([])) ; Cs ← e)
= (True, frs',
(None, h', (vs, l, C, M, pc, Called []) # frs, sh'),
∃vs'. P ⊢ (None,h,frs',sh)
-jvm→ handle P C M xa h' (vs'@vs) l pc ics frs sh')"
proof -
have cond: "Jcc_cond P⇩1 E C M vs pc ics I h sh (INIT C' (C⇩0 # Cs,True) ← e)" using assms by simp
then have clinit: "∃T. P⇩1,E,h,sh ⊢⇩1 C⇩0∙⇩sclinit([]) : T" using wf
by clarsimp (auto simp: is_class_def intro: wf⇩1_types_clinit)
then obtain T where cT: "P⇩1,E,h,sh ⊢⇩1 C⇩0∙⇩sclinit([]) : T" by blast
obtain T where "P⇩1,E,h,sh ⊢⇩1 INIT C' (C⇩0 # Cs,True) ← unit : T" using cond by fastforce
then have "P⇩1,E,h,sh ⊢⇩1 RI (C⇩0,C⇩0∙⇩sclinit([])) ; Cs ← unit : T"
using assms by (auto intro: cT)
then have wtrt: "Ex (WTrt2⇩1 P⇩1 E h sh (RI (C⇩0,C⇩0∙⇩sclinit([])) ; Cs ← unit))"
by(simp only: exI)
then show ?thesis using assms by simp
qed
lemma Jcc_pieces_RInit_clinit:
assumes [simp]: "P ≡ compP⇩2 P⇩1" and wf: "wf_J⇩1_prog P⇩1"
and "Jcc_pieces P⇩1 E C M h vs l pc ics frs sh I h⇩1 l⇩1 sh⇩1 v xa (RI (C⇩0,C⇩0∙⇩sclinit([]));Cs ← e)
= (True, frs',
(None, h⇩1, (vs, l, C, M, pc, Called []) # frs, sh⇩1), err)"
shows
"Jcc_pieces P⇩1 E C M h vs l pc (Called Cs) (tl frs') sh I h' l' sh' v xa (C⇩0∙⇩sclinit([]))
= (True, create_init_frame P C⇩0#(vs,l,C,M,pc,Called Cs)#tl frs',
(None, h', (vs,l,C,M,pc,Called Cs)#tl frs', sh'(C⇩0↦(fst(the(sh' C⇩0)),Done))),
P ⊢ (None,h,create_init_frame P C⇩0#(vs,l,C,M,pc,Called Cs)#tl frs',sh)
-jvm→ (None,h',(vs, l, C, M, pc, Throwing Cs xa) # tl frs',sh'(C⇩0 ↦ (fst(the(sh' C⇩0)),Error))))"
proof -
have cond: "Jcc_cond P⇩1 E C M vs pc ics I h sh (RI (C⇩0,C⇩0∙⇩sclinit([]));Cs ← e)" using assms by simp
then have wtrt: "∃T. P⇩1,E,h,sh ⊢⇩1 C⇩0∙⇩sclinit([]) : T" using wf
by clarsimp (auto simp: is_class_def intro: wf⇩1_types_clinit)
then show ?thesis using assms by clarsimp
qed
lemma Jcc_pieces_RInit_Init:
assumes [simp]: "P ≡ compP⇩2 P⇩1" and wf: "wf_J⇩1_prog P⇩1"
and proc: "∀C' ∈ set Cs. ∃sfs. sh'' C' = ⌊(sfs,Processing)⌋"
and "Jcc_pieces P⇩1 E C M h vs l pc ics frs sh I h⇩1 l⇩1 sh⇩1 v xa (RI (C⇩0,C⇩0∙⇩sclinit([]));Cs ← e)
= (True, frs',
(None, h⇩1, (vs, l, C, M, pc, Called []) # frs, sh⇩1), err)"
shows
"Jcc_pieces P⇩1 E C M h' vs l pc ics frs sh'' I h⇩1 l⇩1 sh⇩1 v xa (INIT (last (C⇩0#Cs)) (Cs,True) ← e)
= (True, (vs, l, C, M, pc, Called Cs) # frs,
(None, h⇩1, (vs, l, C, M, pc, Called []) # frs, sh⇩1),
∃vs'. P ⊢ (None,h',(vs, l, C, M, pc, Called Cs) # frs,sh'')
-jvm→ handle P C M xa h⇩1 (vs'@vs) l pc ics frs sh⇩1)"
proof -
have "Jcc_cond P⇩1 E C M vs pc ics I h sh (RI (C⇩0,C⇩0∙⇩sclinit([]));Cs ← e)" using assms by simp
then have "Ex (WTrt2⇩1 P⇩1 E h sh (RI (C⇩0,C⇩0∙⇩sclinit([])) ; Cs ← unit))" by simp
then obtain T where riwt: "P⇩1,E,h,sh ⊢⇩1 RI (C⇩0,C⇩0∙⇩sclinit([]));Cs ← unit : T" by meson
then have "P⇩1,E,h',sh'' ⊢⇩1 INIT (last (C⇩0#Cs)) (Cs,True) ← unit : T" using proc
proof(cases Cs) qed(auto)
then have wtrt: "Ex (WTrt2⇩1 P⇩1 E h' sh'' (INIT (last (C⇩0#Cs)) (Cs,True) ← unit))" by(simp only: exI)
show ?thesis using assms wtrt
proof(cases Cs)
case (Cons C1 Cs1)
then show ?thesis using assms wtrt
by(case_tac "method P C1 clinit") clarsimp
qed(clarsimp)
qed
lemma Jcc_pieces_RInit_RInit:
assumes [simp]: "P ≡ compP⇩2 P⇩1"
and "Jcc_pieces P⇩1 E C M h vs l pc ics frs sh I h⇩1 l⇩1 sh⇩1 v xa (RI (C⇩0,e);D#Cs ← e')
= (True, frs', rhs, err)"
and hd: "hd frs' = (vs1,l1,C1,M1,pc1,ics1)"
shows
"Jcc_pieces P⇩1 E C M h' vs l pc ics frs sh'' I h⇩1 l⇩1 sh⇩1 v xa (RI (D,Throw xa) ; Cs ← e')
= (True, (vs1, l1, C1, M1, pc1, Throwing (D#Cs) xa) # tl frs',
(None, h⇩1, (vs, l, C, M, pc, Called []) # frs, sh⇩1),
∃vs'. P ⊢ (None,h',(vs1, l1, C1, M1, pc1, Throwing (D#Cs) xa) # tl frs',sh'')
-jvm→ handle P C M xa h⇩1 (vs'@vs) l pc ics frs sh⇩1)"
using assms by(case_tac "method P D clinit", cases "e = C⇩0∙⇩sclinit([])") clarsimp+
subsubsection "JVM stepping lemmas"
lemma jvm_Invoke:
assumes [simp]: "P ≡ compP⇩2 P⇩1"
and "P,C,M,pc ▹ Invoke M' (length Ts)"
and ha: "h⇩2 a = ⌊(Ca, fs)⌋" and method: "P⇩1 ⊢ Ca sees M', NonStatic : Ts→T = body in D"
and len: "length pvs = length Ts" and "ls⇩2' = Addr a # pvs @ replicate (max_vars body) undefined"
shows "P ⊢ (None, h⇩2, (rev pvs @ Addr a # vs, ls⇩2, C, M, pc, No_ics) # frs, sh⇩2) -jvm→
(None, h⇩2, ([], ls⇩2', D, M', 0, No_ics) # (rev pvs @ Addr a # vs, ls⇩2, C, M, pc, No_ics) # frs, sh⇩2)"
proof -
have cname: "cname_of h⇩2 (the_Addr ((rev pvs @ Addr a # vs) ! length Ts)) = Ca"
using ha method len by(auto simp: nth_append)
have r: "(rev pvs @ Addr a # vs) ! (length Ts) = Addr a" using len by(auto simp: nth_append)
have exm: "∃Ts T m D b. P ⊢ Ca sees M',b:Ts → T = m in D"
using sees_method_compP[OF method] by fastforce
show ?thesis using assms cname r exm by simp
qed
lemma jvm_Invokestatic:
assumes [simp]: "P ≡ compP⇩2 P⇩1"
and "P,C,M,pc ▹ Invokestatic C' M' (length Ts)"
and sh: "sh⇩2 D = Some(sfs,Done)"
and method: "P⇩1 ⊢ C' sees M', Static : Ts→T = body in D"
and len: "length pvs = length Ts" and "ls⇩2' = pvs @ replicate (max_vars body) undefined"
shows "P ⊢ (None, h⇩2, (rev pvs @ vs, ls⇩2, C, M, pc, No_ics) # frs, sh⇩2) -jvm→
(None, h⇩2, ([], ls⇩2', D, M', 0, No_ics) # (rev pvs @ vs, ls⇩2, C, M, pc, No_ics) # frs, sh⇩2)"
proof -
have exm: "∃Ts T m D b. P ⊢ C' sees M',b:Ts → T = m in D"
using sees_method_compP[OF method] by fastforce
show ?thesis using assms exm by simp
qed
lemma jvm_Invokestatic_Called:
assumes [simp]: "P ≡ compP⇩2 P⇩1"
and "P,C,M,pc ▹ Invokestatic C' M' (length Ts)"
and sh: "sh⇩2 D = Some(sfs,i)"
and method: "P⇩1 ⊢ C' sees M', Static : Ts→T = body in D"
and len: "length pvs = length Ts" and "ls⇩2' = pvs @ replicate (max_vars body) undefined"
shows "P ⊢ (None, h⇩2, (rev pvs @ vs, ls⇩2, C, M, pc, Called []) # frs, sh⇩2) -jvm→
(None, h⇩2, ([], ls⇩2', D, M', 0, No_ics) # (rev pvs @ vs, ls⇩2, C, M, pc, No_ics) # frs, sh⇩2)"
proof -
have exm: "∃Ts T m D b. P ⊢ C' sees M',b:Ts → T = m in D"
using sees_method_compP[OF method] by fastforce
show ?thesis using assms exm by simp
qed
lemma jvm_Return_Init:
"P,D,clinit,0 ⊳ compE⇩2 body @ [Return]
⟹ P ⊢ (None, h, (vs, ls, D, clinit, size(compE⇩2 body), No_ics) # frs, sh)
-jvm→ (None, h, frs, sh(D↦(fst(the(sh D)),Done)))"
apply(simp add: exec_all_def1, rule r_into_rtrancl, rule exec_1I)
apply(cases frs, auto)
done
lemma jvm_InitNone:
"⟦ ics_of f = Calling C Cs;
sh C = None ⟧
⟹ P ⊢ (None,h,f#frs,sh) -jvm→ (None,h,f#frs,sh(C ↦ (sblank P C, Prepared)))"
apply(simp add: exec_all_def1, rule r_into_rtrancl, rule exec_1I)
apply(cases f) apply(rename_tac ics, case_tac ics, simp_all)
done
lemma jvm_InitDP:
"⟦ ics_of f = Calling C Cs;
sh C = ⌊(sfs,i)⌋; i = Done ∨ i = Processing ⟧
⟹ P ⊢ (None,h,f#frs,sh) -jvm→ (None,h,(calling_to_scalled f)#frs,sh)"
apply(simp add: exec_all_def1, rule r_into_rtrancl, rule exec_1I)
apply(cases f)
apply(erule_tac P = "i = Done" in disjE)
apply simp_all
done
lemma jvm_InitError:
"sh C = ⌊(sfs,Error)⌋
⟹ P ⊢ (None,h,(vs,ls,C⇩0,M,pc,Calling C Cs)#frs,sh)
-jvm→ (None,h,(vs,ls,C⇩0,M,pc,Throwing Cs (addr_of_sys_xcpt NoClassDefFoundError))#frs,sh)"
by(clarsimp simp: exec_all_def1 intro!: r_into_rtrancl exec_1I)
lemma exec_ErrorThrowing:
"sh C = ⌊(sfs,Error)⌋
⟹ exec (P, (None,h,calling_to_throwing (stk,loc,D,M,pc,Calling C Cs) a#frs,sh))
= Some (None,h,calling_to_sthrowing (stk,loc,D,M,pc,Calling C Cs) a #frs,sh)"
by(clarsimp simp: exec_all_def1 fun_upd_idem_iff intro!: r_into_rtrancl exec_1I)
lemma jvm_InitObj:
"⟦ sh C = Some(sfs,Prepared);
C = Object;
sh' = sh(C ↦ (sfs,Processing)) ⟧
⟹ P ⊢ (None, h, (vs,ls,C⇩0,M,pc,Calling C Cs)#frs, sh) -jvm→
(None, h, (vs,ls,C⇩0,M,pc,Called (C#Cs))#frs,sh')"
apply(simp add: exec_all_def1, rule r_into_rtrancl, rule exec_1I)
apply(case_tac "method P C clinit", simp)
done
lemma jvm_InitNonObj:
"⟦ sh C = Some(sfs,Prepared);
C ≠ Object;
class P C = Some (D,r);
sh' = sh(C ↦ (sfs,Processing)) ⟧
⟹ P ⊢ (None, h, (vs,ls,C⇩0,M,pc,Calling C Cs)#frs, sh) -jvm→
(None, h, (vs,ls,C⇩0,M,pc,Calling D (C#Cs))#frs, sh')"
apply(simp add: exec_all_def1, rule r_into_rtrancl, rule exec_1I)
apply(case_tac "method P C clinit", simp)
done
lemma jvm_RInit_throw:
"P ⊢ (None,h,(vs,l,C,M,pc,Throwing [] xa) # frs,sh)
-jvm→ handle P C M xa h vs l pc No_ics frs sh"
apply(simp add: exec_all_def1, rule r_into_rtrancl, rule exec_1I)
apply(simp add: handle_def split: bool.splits)
done
lemma jvm_RInit_throw':
"P ⊢ (None,h,(vs,l,C,M,pc,Throwing [C'] xa) # frs,sh)
-jvm→ handle P C M xa h vs l pc No_ics frs (sh(C':=Some(fst(the(sh C')), Error)))"
apply(simp add: exec_all_def1)
apply(rule_tac y = "(None,h,(vs,l,C,M,pc,Throwing [] xa) # frs,sh(C':=Some(fst(the(sh C')), Error)))" in rtrancl_trans)
apply(rule r_into_rtrancl, rule exec_1I)
apply(simp add: handle_def)
apply(cut_tac jvm_RInit_throw)
apply(simp add: exec_all_def1)
done
lemma jvm_Called:
"P ⊢ (None, h, (vs, l, C, M, pc, Called (C⇩0 # Cs)) # frs, sh) -jvm→
(None, h, create_init_frame P C⇩0 # (vs, l, C, M, pc, Called Cs) # frs, sh)"
by(simp add: exec_all_def1 r_into_rtrancl exec_1I)
lemma jvm_Throwing:
"P ⊢ (None, h, (vs, l, C, M, pc, Throwing (C⇩0#Cs) xa') # frs, sh) -jvm→
(None, h, (vs, l, C, M, pc, Throwing Cs xa') # frs, sh(C⇩0 ↦ (fst (the (sh C⇩0)), Error)))"
by(simp add: exec_all_def1 r_into_rtrancl exec_1I)
subsubsection "Other lemmas for correctness proof"
lemma assumes wf:"wf_prog wf_md P"
and ex: "class P C = Some a"
shows create_init_frame_wf_eq: "create_init_frame (compP⇩2 P) C = (stk,loc,D,M,pc,ics) ⟹ D=C"
using wf_sees_clinit[OF wf ex] by(cases "method P C clinit", auto)
lemma beforex_try:
"⟦ {pc..<pc+size(compE⇩2(try e⇩1 catch(Ci i) e⇩2))} ⊆ I;
P,C,M ⊳ compxE⇩2 (try e⇩1 catch(Ci i) e⇩2) pc (size vs) / I,size vs ⟧
⟹ P,C,M ⊳ compxE⇩2 e⇩1 pc (size vs) / {pc..<pc + length (compE⇩2 e⇩1)},size vs"
apply(clarsimp simp:beforex_def split:if_split_asm)
apply(rename_tac xt⇩0 xt⇩1) apply(rule_tac x=xt⇩0 in exI)
apply(auto simp: pcs_subset(1))
using atLeastLessThan_iff by blast
lemma
shows eval⇩1_init_return: "P ⊢⇩1 ⟨e,s⟩ ⇒ ⟨e',s'⟩
⟹ iconf (shp⇩1 s) e
⟹ (∃Cs b. e = INIT C' (Cs,b) ← unit) ∨ (∃C e⇩0 Cs e⇩i. e = RI(C,e⇩0);Cs@[C'] ← unit)
∨ (∃e⇩0. e = RI(C',e⇩0);Nil ← unit)
⟹ (val_of e' = Some v ⟶ (∃sfs i. shp⇩1 s' C' = ⌊(sfs,i)⌋ ∧ (i = Done ∨ i = Processing)))
∧ (throw_of e' = Some a ⟶ (∃sfs i. shp⇩1 s' C' = ⌊(sfs,Error)⌋))"
and "P ⊢⇩1 ⟨es,s⟩ [⇒] ⟨es',s'⟩ ⟹ True"
proof(induct rule: eval⇩1_evals⇩1.inducts)
case (InitFinal⇩1 e s e' s' C b) then show ?case
by(auto simp: initPD_def dest: eval⇩1_final_same)
next
case (InitDone⇩1 sh C sfs C' Cs e h l e' s')
then have "final e'" using eval⇩1_final by simp
then show ?case
proof(rule finalE)
fix v assume e': "e' = Val v" then show ?thesis using InitDone⇩1 initPD_def
proof(cases Cs) qed(auto)
next
fix a assume e': "e' = throw a" then show ?thesis using InitDone⇩1 initPD_def
proof(cases Cs) qed(auto)
qed
next
case (InitProcessing⇩1 sh C sfs C' Cs e h l e' s')
then have "final e'" using eval⇩1_final by simp
then show ?case
proof(rule finalE)
fix v assume e': "e' = Val v" then show ?thesis using InitProcessing⇩1 initPD_def
proof(cases Cs) qed(auto)
next
fix a assume e': "e' = throw a" then show ?thesis using InitProcessing⇩1 initPD_def
proof(cases Cs) qed(auto)
qed
next
case (InitError⇩1 sh C sfs Cs e h l e' s' C') show ?case
proof(cases Cs)
case Nil then show ?thesis using InitError⇩1 by simp
next
case (Cons C2 list)
then have "final e'" using InitError⇩1 eval⇩1_final by simp
then show ?thesis
proof(rule finalE)
fix v assume e': "e' = Val v" show ?thesis
using InitError⇩1.hyps(2) e' rinit⇩1_throwE by blast
next
fix a assume e': "e' = throw a"
then show ?thesis using Cons InitError⇩1 cons_to_append[of list] by clarsimp
qed
qed
next
case (InitRInit⇩1 C Cs h l sh e' s' C') show ?case
proof(cases Cs)
case Nil then show ?thesis using InitRInit⇩1 by simp
next
case (Cons C' list) then show ?thesis
using InitRInit⇩1 Cons cons_to_append[of list] by clarsimp
qed
next
case (RInit⇩1 e s v h' l' sh' C sfs i sh'' C' Cs e' e⇩1 s⇩1)
then have final: "final e⇩1" using eval⇩1_final by simp
then show ?case
proof(cases Cs)
case Nil show ?thesis using final
proof(rule finalE)
fix v assume e': "e⇩1 = Val v" show ?thesis
using RInit⇩1 Nil by(clarsimp, meson fun_upd_same initPD_def)
next
fix a assume e': "e⇩1 = throw a" show ?thesis
using RInit⇩1 Nil by(clarsimp, meson fun_upd_same initPD_def)
qed
next
case (Cons a list) show ?thesis using final
proof(rule finalE)
fix v assume e': "e⇩1 = Val v" then show ?thesis
using RInit⇩1 Cons by(clarsimp, metis last.simps last_appendR list.distinct(1))
next
fix a assume e': "e⇩1 = throw a" then show ?thesis
using RInit⇩1 Cons by(clarsimp, metis last.simps last_appendR list.distinct(1))
qed
qed
next
case (RInitInitFail⇩1 e s a h' l' sh' C sfs i sh'' D Cs e' e⇩1 s⇩1)
then have final: "final e⇩1" using eval⇩1_final by simp
then show ?case
proof(rule finalE)
fix v assume e': "e⇩1 = Val v" then show ?thesis
using RInitInitFail⇩1 by(clarsimp, meson exp.distinct(101) rinit⇩1_throwE)
next
fix a' assume e': "e⇩1 = Throw a'"
then have "iconf (sh'(C ↦ (sfs, Error))) a"
using RInitInitFail⇩1.hyps(1) eval⇩1_final by fastforce
then show ?thesis using RInitInitFail⇩1 e'
by(clarsimp, meson Cons_eq_append_conv list.inject)
qed
qed(auto simp: fun_upd_same)
lemma init⇩1_Val_PD: "P ⊢⇩1 ⟨INIT C' (Cs,b) ← unit,s⟩ ⇒ ⟨Val v,s'⟩
⟹ iconf (shp⇩1 s) (INIT C' (Cs,b) ← unit)
⟹ ∃sfs i. shp⇩1 s' C' = ⌊(sfs,i)⌋ ∧ (i = Done ∨ i = Processing)"
by(drule_tac v = v in eval⇩1_init_return, simp+)
lemma init⇩1_throw_PD: "P ⊢⇩1 ⟨INIT C' (Cs,b) ← unit,s⟩ ⇒ ⟨throw a,s'⟩
⟹ iconf (shp⇩1 s) (INIT C' (Cs,b) ← unit)
⟹ ∃sfs i. shp⇩1 s' C' = ⌊(sfs,Error)⌋"
by(drule_tac a = a in eval⇩1_init_return, simp+)
lemma rinit⇩1_Val_PD: "P ⊢⇩1 ⟨RI(C,e⇩0);Cs ← unit,s⟩ ⇒ ⟨Val v,s'⟩
⟹ iconf (shp⇩1 s) (RI(C,e⇩0);Cs ← unit) ⟹ last(C#Cs) = C'
⟹ ∃sfs i. shp⇩1 s' C' = ⌊(sfs,i)⌋ ∧ (i = Done ∨ i = Processing)"
apply(drule_tac C' = C' and v = v in eval⇩1_init_return, simp_all)
apply (metis append_butlast_last_id)
done
lemma rinit⇩1_throw_PD: "P ⊢⇩1 ⟨RI(C,e⇩0);Cs ← unit,s⟩ ⇒ ⟨throw a,s'⟩
⟹ iconf (shp⇩1 s) (RI(C,e⇩0);Cs ← unit) ⟹ last(C#Cs) = C'
⟹ ∃sfs i. shp⇩1 s' C' = ⌊(sfs,Error)⌋"
apply(drule_tac C' = C' and a = a in eval⇩1_init_return, simp_all)
apply (metis append_butlast_last_id)
done
subsubsection "The proof"
lemma fixes P⇩1 defines [simp]: "P ≡ compP⇩2 P⇩1"
assumes wf: "wf_J⇩1_prog P⇩1"
shows Jcc: "P⇩1 ⊢⇩1 ⟨e,(h⇩0,ls⇩0,sh⇩0)⟩ ⇒ ⟨ef,(h⇩1,ls⇩1,sh⇩1)⟩ ⟹
(⋀E C M pc ics v xa vs frs I.
⟦ Jcc_cond P⇩1 E C M vs pc ics I h⇩0 sh⇩0 e ⟧ ⟹
(ef = Val v ⟶
P ⊢ (None,h⇩0,Jcc_frames P C M vs ls⇩0 pc ics frs e,sh⇩0)
-jvm→ Jcc_rhs P⇩1 E C M vs ls⇩0 pc ics frs h⇩1 ls⇩1 sh⇩1 v e)
∧
(ef = Throw xa ⟶ Jcc_err P C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩1 ls⇩1 sh⇩1 xa e)
)"
(is "_ ⟹ (⋀E C M pc ics v xa vs frs I.
PROP ?P e h⇩0 ls⇩0 sh⇩0 ef h⇩1 ls⇩1 sh⇩1 E C M pc ics v xa vs frs I)")
and "P⇩1 ⊢⇩1 ⟨es,(h⇩0,ls⇩0,sh⇩0)⟩ [⇒] ⟨fs,(h⇩1,ls⇩1,sh⇩1)⟩ ⟹
(⋀C M pc ics ws xa es' vs frs I.
⟦ P,C,M,pc ⊳ compEs⇩2 es; P,C,M ⊳ compxEs⇩2 es pc (size vs)/I,size vs;
{pc..<pc+size(compEs⇩2 es)} ⊆ I; ics = No_ics;
¬sub_RIs es ⟧ ⟹
(fs = map Val ws ⟶
P ⊢ (None,h⇩0,(vs,ls⇩0,C,M,pc,ics)#frs,sh⇩0) -jvm→
(None,h⇩1,(rev ws @ vs,ls⇩1,C,M,pc+size(compEs⇩2 es),ics)#frs,sh⇩1))
∧
(fs = map Val ws @ Throw xa # es' ⟶
(∃pc⇩1. pc ≤ pc⇩1 ∧ pc⇩1 < pc + size(compEs⇩2 es) ∧
¬ caught P pc⇩1 h⇩1 xa (compxEs⇩2 es pc (size vs)) ∧
(∃vs'. P ⊢ (None,h⇩0,(vs,ls⇩0,C,M,pc,ics)#frs,sh⇩0)
-jvm→ handle P C M xa h⇩1 (vs'@vs) ls⇩1 pc⇩1 ics frs sh⇩1))))"
(is "_ ⟹ (⋀C M pc ics ws xa es' vs frs I.
PROP ?Ps es h⇩0 ls⇩0 sh⇩0 fs h⇩1 ls⇩1 sh⇩1 C M pc ics ws xa es' vs frs I)")
proof (induct rule:eval⇩1_evals⇩1_inducts)
case New⇩1 thus ?case by auto
next
case (NewFail⇩1 sh C' sfs h ls)
let ?xa = "addr_of_sys_xcpt OutOfMemory"
have "P ⊢ (None,h,(vs,ls,C,M,pc,ics)#frs,sh) -jvm→ handle P C M ?xa h vs ls pc ics frs sh"
using NewFail⇩1 by(clarsimp simp: handle_def)
then show ?case by(auto intro!: exI[where x="[]"])
next
case (NewInit⇩1 sh C' h ls v' h' ls' sh' a FDTs h'')
then obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h vs ls pc ics frs sh I h' ls' sh' v xa (new C')
= (True, frs', (None,h',(v#vs,ls',C,M,pc+size(compE⇩2 (new C')),ics)#frs,sh'), err)"
using NewInit⇩1.prems(1) by clarsimp
have "Ex (WTrt2⇩1 P⇩1 E h sh (INIT C' ([C'],False) ← unit))"
using has_fields_is_class[OF NewInit⇩1.hyps(5)] by auto
then obtain err' where pcs':
"Jcc_pieces P⇩1 E C M h vs ls pc ics frs sh I h' ls' sh' v' xa (INIT C' ([C'],False) ← unit)
= (True, (vs,ls,C,M,pc,Calling C' []) # frs, (None,h',(vs,ls,C,M,pc,Called [])#frs,sh'), err')"
using NewInit⇩1.prems(1) by auto
have IH: "PROP ?P (INIT C' ([C'],False) ← unit) h ls sh (Val v')
h' ls' sh' E C M pc ics v' xa vs frs I" by fact
have ls: "ls = ls'" by(rule init⇩1_same_loc[OF NewInit⇩1.hyps(2)])
obtain sfs i where sh': "sh' C' = Some(sfs,i)"
using init⇩1_Val_PD[OF NewInit⇩1.hyps(2)] by clarsimp
have "P ⊢ (None,h,(vs,ls,C,M,pc,ics)#frs,sh) -jvm→ (None,h,(vs,ls,C,M,pc,Calling C' [])#frs,sh)"
proof(cases "sh C'")
case None then show ?thesis using NewInit⇩1.prems by(cases ics) auto
next
case (Some a)
then obtain sfs i where "a = (sfs,i)" by(cases a)
then show ?thesis using NewInit⇩1.hyps(1) NewInit⇩1.prems Some
by(cases ics; case_tac i) auto
qed
also have "P ⊢ … -jvm→ (None, h', (vs, ls, C, M, pc, Called []) # frs, sh')"
using IH pcs' by auto
also have "P ⊢ … -jvm→ (None, h'', (Addr a#vs, ls, C, M, Suc pc, ics) # frs, sh')"
using NewInit⇩1.hyps(1,2,4-6) NewInit⇩1.prems sh' by(cases ics) auto
finally show ?case using pcs ls by clarsimp
next
case (NewInitOOM⇩1 sh C' h ls v' h' ls' sh')
let ?xa = "addr_of_sys_xcpt OutOfMemory"
obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h vs ls pc ics frs sh I h' ls' sh' v xa (new C')
= (True, frs', (None,h',(v#vs,ls',C,M,pc+size(compE⇩2 (new C')),ics)#frs,sh'), err)"
using NewInitOOM⇩1.prems(1) by clarsimp
have "Ex (WTrt2⇩1 P⇩1 E h sh (INIT C' ([C'],False) ← unit))" using NewInitOOM⇩1.hyps(5) by auto
then obtain err' where pcs':
"Jcc_pieces P⇩1 E C M h vs ls pc ics frs sh I h' ls' sh' v' xa (INIT C' ([C'],False) ← unit)
= (True, (vs,ls,C,M,pc,Calling C' []) # frs, (None,h',(vs,ls,C,M,pc,Called [])#frs,sh'), err')"
using NewInitOOM⇩1.prems(1) by auto
have IH: "PROP ?P (INIT C' ([C'],False) ← unit) h ls sh (Val v')
h' ls' sh' E C M pc ics v' xa vs frs I" by fact
have ls: "ls = ls'" by(rule init⇩1_same_loc[OF NewInitOOM⇩1.hyps(2)])
have "iconf (shp⇩1 (h, ls, sh)) (INIT C' ([C'],False) ← unit)" by simp
then obtain sfs i where sh': "sh' C' = Some(sfs,i)"
using init⇩1_Val_PD[OF NewInitOOM⇩1.hyps(2)] by clarsimp
have "P ⊢ (None,h,(vs,ls,C,M,pc,ics)#frs,sh) -jvm→ (None,h,(vs,ls,C,M,pc,Calling C' [])#frs,sh)"
proof(cases "sh C'")
case None then show ?thesis using NewInitOOM⇩1.prems by(cases ics) auto
next
case (Some a)
then obtain sfs i where "a = (sfs,i)" by(cases a)
then show ?thesis using NewInitOOM⇩1.hyps(1) NewInitOOM⇩1.prems Some
by(cases ics; case_tac i) auto
qed
also have "P ⊢ … -jvm→ (None, h', (vs, ls, C, M, pc, Called []) # frs, sh')"
using IH pcs' by auto
also have "P ⊢ … -jvm→ handle P C M ?xa h' vs ls pc ics frs sh'"
using NewInitOOM⇩1.hyps(1,2,4,5) NewInitOOM⇩1.prems sh' by(auto simp: handle_def)
finally show ?case using pcs ls by(simp, metis (no_types) append_Nil le_refl lessI)
next
case (NewInitThrow⇩1 sh C' h ls a h' ls' sh')
obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h vs ls pc ics frs sh I h' ls' sh' v xa (new C')
= (True, frs', (None,h',(v#vs,ls',C,M,pc+size(compE⇩2 (new C')),ics)#frs,sh'), err)"
using NewInitThrow⇩1.prems(1) by clarsimp
obtain a' where throw: "throw a = Throw a'" using eval⇩1_final[OF NewInitThrow⇩1.hyps(2)] by clarsimp
have "Ex (WTrt2⇩1 P⇩1 E h sh (INIT C' ([C'],False) ← unit))" using NewInitThrow⇩1.hyps(4) by auto
then obtain vs' where pcs':
"Jcc_pieces P⇩1 E C M h vs ls pc ics frs sh I h' ls' sh' v a' (INIT C' ([C'],False) ← unit)
= (True, (vs,ls,C,M,pc,Calling C' []) # frs, (None,h',(vs,ls,C,M,pc,Called [])#frs,sh'),
P ⊢ (None,h,(vs,ls,C,M,pc,Calling C' []) # frs,sh)
-jvm→ handle P C M a' h' (vs'@vs) ls pc ics frs sh')"
using NewInitThrow⇩1.prems(1) by simp blast
have IH: "PROP ?P (INIT C' ([C'],False) ← unit) h ls sh (throw a)
h' ls' sh' E C M pc ics v a' vs frs I" by fact
have ls: "ls = ls'" by(rule init⇩1_same_loc[OF NewInitThrow⇩1.hyps(2)])
then have "P ⊢ (None,h,(vs,ls,C,M,pc,ics)#frs,sh) -jvm→ (None,h,(vs,ls,C,M,pc,Calling C' []) # frs,sh)"
proof(cases "sh C'")
case None then show ?thesis using NewInitThrow⇩1.prems by(cases ics) auto
next
case (Some a)
then obtain sfs i where "a = (sfs,i)" by(cases a)
then show ?thesis using NewInitThrow⇩1.hyps(1) NewInitThrow⇩1.prems Some
by(cases ics; case_tac i) auto
qed
also have "P ⊢ … -jvm→ handle P C M a' h' (vs'@vs) ls pc ics frs sh'" using IH pcs' throw by auto
finally show ?case using throw ls by auto
next
case (Cast⇩1 e h⇩0 ls⇩0 sh⇩0 a h⇩1 ls⇩1 sh⇩1 D fs C')
let ?pc = "pc + length(compE⇩2 e)"
obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩1 ls⇩1 sh⇩1 v xa (Cast C' e)
= (True, frs', (None,h⇩1,(v#vs,ls⇩1,C,M,pc+size(compE⇩2 (Cast C' e)),ics)#frs,sh⇩1), err)"
using Cast⇩1.prems(1) by auto
have IH: "PROP ?P e h⇩0 ls⇩0 sh⇩0 (addr a) h⇩1 ls⇩1 sh⇩1 E C M pc ics (Addr a) xa vs frs I" by fact
then have "P ⊢ (None,h⇩0,(vs,ls⇩0,C,M,pc,ics)#frs,sh⇩0) -jvm→
(None,h⇩1,(Addr a#vs,ls⇩1,C,M,?pc,ics)#frs,sh⇩1)"
using Jcc_pieces_Cast[OF assms(1) pcs, of "Addr a"] Cast⇩1.prems pcs by auto
also have "P ⊢ … -jvm→ (None,h⇩1,(Addr a#vs,ls⇩1,C,M,?pc+1,ics)#frs,sh⇩1)"
using Cast⇩1 by (auto simp add:cast_ok_def)
finally show ?case by auto
next
case (CastNull⇩1 e h⇩0 ls⇩0 sh⇩0 h⇩1 ls⇩1 sh⇩1 C')
let ?pc = "pc + length(compE⇩2 e)"
obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩1 ls⇩1 sh⇩1 v xa (Cast C' e)
= (True, frs', (None,h⇩1,(v#vs,ls⇩1,C,M,pc+size(compE⇩2 (Cast C' e)),ics)#frs,sh⇩1), err)"
using CastNull⇩1.prems(1) by clarsimp
have IH: "PROP ?P e h⇩0 ls⇩0 sh⇩0 null h⇩1 ls⇩1 sh⇩1 E C M pc ics Null xa vs frs I" by fact
then have "P ⊢ (None,h⇩0,(vs,ls⇩0,C,M,pc,ics)#frs,sh⇩0) -jvm→
(None,h⇩1,(Null#vs,ls⇩1,C,M,?pc,ics)#frs,sh⇩1)"
using Jcc_pieces_Cast[OF assms(1) pcs, of Null] CastNull⇩1.prems pcs by auto
also have "P ⊢ … -jvm→ (None,h⇩1,(Null#vs,ls⇩1,C,M,?pc+1,ics)#frs,sh⇩1)"
using CastNull⇩1 by (auto simp add:cast_ok_def)
finally show ?case by auto
next
case (CastFail⇩1 e h⇩0 ls⇩0 sh⇩0 a h⇩1 ls⇩1 sh⇩1 D fs C')
let ?pc = "pc + length(compE⇩2 e)"
let ?xa = "addr_of_sys_xcpt ClassCast"
obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩1 ls⇩1 sh⇩1 v xa (Cast C' e)
= (True, frs', (None,h⇩1,(v#vs,ls⇩1,C,M,pc+size(compE⇩2 (Cast C' e)),ics)#frs,sh⇩1), err)"
using CastFail⇩1.prems(1) by clarsimp
have IH: "PROP ?P e h⇩0 ls⇩0 sh⇩0 (addr a) h⇩1 ls⇩1 sh⇩1 E C M pc ics (Addr a) xa vs frs I" by fact
then have "P ⊢ (None,h⇩0,(vs,ls⇩0,C,M,pc,ics)#frs,sh⇩0) -jvm→
(None,h⇩1,(Addr a#vs,ls⇩1,C,M,?pc,ics)#frs,sh⇩1)"
using Jcc_pieces_Cast[OF assms(1) pcs, of "Addr a"] CastFail⇩1.prems pcs by auto
also have "P ⊢ … -jvm→ handle P C M ?xa h⇩1 (Addr a#vs) ls⇩1 ?pc ics frs sh⇩1"
using CastFail⇩1 by (auto simp add:handle_def cast_ok_def)
finally have exec: "P ⊢ (None,h⇩0,(vs,ls⇩0,C,M,pc,ics)#frs,sh⇩0) -jvm→ …".
show ?case (is "?N ∧ (?eq ⟶ ?err)")
proof
show ?N by simp
next
{ assume ?eq
then have ?err using exec by (auto intro!: exI[where x="?pc"] exI[where x="[Addr a]"])
}
thus "?eq ⟶ ?err" by simp
qed
next
case (CastThrow⇩1 e h⇩0 ls⇩0 sh⇩0 e' h⇩1 ls⇩1 sh⇩1 C')
obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩1 ls⇩1 sh⇩1 v xa (Cast C' e)
= (True, frs', (None,h⇩1,(v#vs,ls⇩1,C,M,pc+size(compE⇩2 (Cast C' e)),ics)#frs,sh⇩1), err)"
using CastThrow⇩1.prems(1) by clarsimp
have IH: "PROP ?P e h⇩0 ls⇩0 sh⇩0 (throw e') h⇩1 ls⇩1 sh⇩1 E C M pc ics v xa vs frs I" by fact
show ?case using IH Jcc_pieces_Cast[OF assms(1) pcs, of v] CastThrow⇩1.prems pcs less_SucI
by(simp, blast)
next
case Val⇩1 thus ?case by auto
next
case Var⇩1 thus ?case by auto
next
case (BinOp⇩1 e⇩1 h⇩0 ls⇩0 sh⇩0 v⇩1 h⇩1 ls⇩1 sh⇩1 e⇩2 v⇩2 h⇩2 ls⇩2 sh⇩2 bop w)
obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩2 ls⇩2 sh⇩2 v xa (e⇩1 «bop» e⇩2)
= (True, frs', (None,h⇩2,(v#vs,ls⇩2,C,M,pc+size(compE⇩2 (e⇩1 «bop» e⇩2)),ics)#frs,sh⇩2), err)"
using BinOp⇩1.prems(1) by clarsimp
let ?pc⇩1 = "pc + length(compE⇩2 e⇩1)"
let ?pc⇩2 = "?pc⇩1 + length(compE⇩2 e⇩2)"
have IH⇩1: "PROP ?P e⇩1 h⇩0 ls⇩0 sh⇩0 (Val v⇩1) h⇩1 ls⇩1 sh⇩1 E C M pc ics v⇩1 xa vs frs
(I - pcs (compxE⇩2 e⇩2 (pc + length (compE⇩2 e⇩1)) (Suc (length vs))))" by fact
have IH⇩2: "PROP ?P e⇩2 h⇩1 ls⇩1 sh⇩1 (Val v⇩2) h⇩2 ls⇩2 sh⇩2 E C M ?pc⇩1 ics v⇩2 xa (v⇩1#vs) frs
(I - pcs(compxE⇩2 e⇩1 pc (size vs)))" by fact
have "P ⊢ (None,h⇩0,frs',sh⇩0) -jvm→ (None,h⇩1,(v⇩1#vs,ls⇩1,C,M,?pc⇩1,ics)#frs,sh⇩1)"
using IH⇩1 Jcc_pieces_BinOp1[OF pcs, of h⇩1 ls⇩1 sh⇩1 v⇩1] by simp
also have "P ⊢ … -jvm→ (None,h⇩2,(v⇩2#v⇩1#vs,ls⇩2,C,M,?pc⇩2,ics)#frs,sh⇩2)"
using IH⇩2 Jcc_pieces_BinOp2[OF assms(1) pcs, of h⇩1 v⇩1 ls⇩1 sh⇩1 v⇩2] by (simp add: add.assoc)
also have "P ⊢ … -jvm→ (None,h⇩2,(w#vs,ls⇩2,C,M,?pc⇩2+1,ics)#frs,sh⇩2)"
using BinOp⇩1 by(cases bop) auto
finally show ?case using pcs by (auto split: bop.splits simp:add.assoc)
next
case (BinOpThrow⇩1⇩1 e⇩1 h⇩0 ls⇩0 sh⇩0 e h⇩1 ls⇩1 sh⇩1 bop e⇩2)
obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩1 ls⇩1 sh⇩1 v xa (e⇩1 «bop» e⇩2)
= (True, frs', (None,h⇩1,(v#vs,ls⇩1,C,M,pc+size(compE⇩2 (e⇩1 «bop» e⇩2)),ics)#frs,sh⇩1), err)"
using BinOpThrow⇩1⇩1.prems(1) by clarsimp
have IH⇩1: "PROP ?P e⇩1 h⇩0 ls⇩0 sh⇩0 (throw e) h⇩1 ls⇩1 sh⇩1 E C M pc ics v xa vs frs
(I - pcs (compxE⇩2 e⇩2 (pc + length (compE⇩2 e⇩1)) (Suc (length vs))))" by fact
show ?case using IH⇩1 Jcc_pieces_BinOp1[OF pcs, of h⇩1 ls⇩1 sh⇩1 v] BinOpThrow⇩1⇩1.prems nsub_RI_Jcc_pieces
by auto
next
case (BinOpThrow⇩2⇩1 e⇩1 h⇩0 ls⇩0 sh⇩0 v⇩1 h⇩1 ls⇩1 sh⇩1 e⇩2 e h⇩2 ls⇩2 sh⇩2 bop)
obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩2 ls⇩2 sh⇩2 v xa (e⇩1 «bop» e⇩2)
= (True, frs', (None,h⇩2,(v#vs,ls⇩2,C,M,pc+size(compE⇩2 (e⇩1 «bop» e⇩2)),ics)#frs,sh⇩2), err)"
using BinOpThrow⇩2⇩1.prems(1) by clarsimp
let ?pc = "pc + length(compE⇩2 e⇩1)"
have IH⇩1: "PROP ?P e⇩1 h⇩0 ls⇩0 sh⇩0 (Val v⇩1) h⇩1 ls⇩1 sh⇩1 E C M pc ics v⇩1 xa vs frs
(I - pcs (compxE⇩2 e⇩2 (pc + length (compE⇩2 e⇩1)) (Suc (length vs))))" by fact
have IH⇩2: "PROP ?P e⇩2 h⇩1 ls⇩1 sh⇩1 (throw e) h⇩2 ls⇩2 sh⇩2 E C M ?pc ics v xa (v⇩1#vs) frs
(I - pcs(compxE⇩2 e⇩1 pc (size vs)))" by fact
let ?σ⇩1 = "(None,h⇩1,(v⇩1#vs,ls⇩1,C,M,?pc,ics)#frs,sh⇩1)"
have 1: "P ⊢ (None,h⇩0,frs',sh⇩0) -jvm→ ?σ⇩1"
using IH⇩1 Jcc_pieces_BinOp1[OF pcs, of h⇩1 ls⇩1 sh⇩1 v⇩1] by simp
have "(throw e = Val v ⟶ P ⊢ (None, h⇩0, Jcc_frames P C M vs ls⇩0 pc ics frs (e⇩1 «bop» e⇩2), sh⇩0) -jvm→
Jcc_rhs P⇩1 E C M vs ls⇩0 pc ics frs h⇩2 ls⇩2 sh⇩2 v (e⇩1 «bop» e⇩2))
∧ (throw e = Throw xa ⟶ (∃pc⇩1. pc ≤ pc⇩1 ∧ pc⇩1 < pc + size(compE⇩2 (e⇩1 «bop» e⇩2)) ∧
¬ caught P pc⇩1 h⇩2 xa (compxE⇩2 (e⇩1 «bop» e⇩2) pc (size vs)) ∧
(∃vs'. P ⊢ (None,h⇩0,frs',sh⇩0) -jvm→ handle P C M xa h⇩2 (vs'@vs) ls⇩2 pc⇩1 ics frs sh⇩2)))"
(is "?N ∧ (?eq ⟶ (∃pc⇩2. ?H pc⇩2))")
proof
show ?N by simp
next
{ assume ?eq
then obtain pc⇩2 vs' where
pc⇩2: "?pc ≤ pc⇩2 ∧ pc⇩2 < ?pc + size(compE⇩2 e⇩2) ∧
¬ caught P pc⇩2 h⇩2 xa (compxE⇩2 e⇩2 ?pc (size vs + 1))" and
2: "P ⊢ ?σ⇩1 -jvm→ handle P C M xa h⇩2 (vs'@v⇩1#vs) ls⇩2 pc⇩2 ics frs sh⇩2"
using IH⇩2 Jcc_pieces_BinOp2[OF assms(1) pcs, of h⇩1 v⇩1 ls⇩1 sh⇩1 v] BinOpThrow⇩2⇩1.prems by clarsimp
then have "?H pc⇩2" using jvm_trans[OF 1 2] by(auto intro!: exI[where x="vs'@[v⇩1]"])
hence "∃pc⇩2. ?H pc⇩2" by iprover
}
thus "?eq ⟶ (∃pc⇩2. ?H pc⇩2)" by iprover
qed
then show ?case using pcs by simp blast
next
case (FAcc⇩1 e h⇩0 ls⇩0 sh⇩0 a h⇩1 ls⇩1 sh⇩1 C' fs F T D w)
then obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩1 ls⇩1 sh⇩1 v xa (e∙F{D})
= (True, frs', (None,h⇩1,(v#vs,ls⇩1,C,M,pc+size(compE⇩2 (e∙F{D})),ics)#frs,sh⇩1), err)"
using FAcc⇩1.prems(1) by clarsimp
have "P⇩1 ⊢ D sees F,NonStatic:T in D" by(rule has_field_sees[OF has_field_idemp[OF FAcc⇩1.hyps(4)]])
then have field: "field P D F = (D,NonStatic,T)" by simp
have IH: "PROP ?P e h⇩0 ls⇩0 sh⇩0 (addr a) h⇩1 ls⇩1 sh⇩1 E C M pc ics (Addr a) xa vs frs I" by fact
let ?pc = "pc + length(compE⇩2 e)"
have "P ⊢ (None,h⇩0,frs',sh⇩0) -jvm→ (None,h⇩1,(Addr a#vs,ls⇩1,C,M,?pc,ics)#frs,sh⇩1)"
using IH Jcc_pieces_FAcc[OF pcs, of "Addr a"] pcs by simp
also have "P ⊢ … -jvm→ (None,h⇩1,(w#vs,ls⇩1,C,M,?pc+1,ics)#frs,sh⇩1)"
using FAcc⇩1 field by auto
finally have "P ⊢ (None, h⇩0, frs', sh⇩0) -jvm→ (None,h⇩1,(w#vs,ls⇩1,C,M,?pc+1,ics)#frs,sh⇩1)"
by auto
then show ?case using pcs by auto
next
case (FAccNull⇩1 e h⇩0 ls⇩0 sh⇩0 h⇩1 ls⇩1 sh⇩1 F D)
then obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩1 ls⇩1 sh⇩1 v xa (e∙F{D})
= (True, frs', (None,h⇩1,(v#vs,ls⇩1,C,M,pc+size(compE⇩2 (e∙F{D})),ics)#frs,sh⇩1), err)"
using FAccNull⇩1.prems(1) by clarsimp
have IH: "PROP ?P e h⇩0 ls⇩0 sh⇩0 null h⇩1 ls⇩1 sh⇩1 E C M pc ics Null xa vs frs I" by fact
let ?pc = "pc + length(compE⇩2 e)"
let ?xa = "addr_of_sys_xcpt NullPointer"
have "P ⊢ (None,h⇩0,frs',sh⇩0) -jvm→ (None,h⇩1,(Null#vs,ls⇩1,C,M,?pc,ics)#frs,sh⇩1)"
using IH Jcc_pieces_FAcc[OF pcs, of Null] by simp
also have "P ⊢ … -jvm→ handle P C M ?xa h⇩1 (Null#vs) ls⇩1 ?pc ics frs sh⇩1"
using FAccNull⇩1.prems
by(fastforce simp:split_beta handle_def simp del: split_paired_Ex)
finally show ?case using pcs by (auto intro!: exI[where x = ?pc] exI[where x="[Null]"])
next
case (FAccThrow⇩1 e h⇩0 ls⇩0 sh⇩0 e' h⇩1 ls⇩1 sh⇩1 F D)
then obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩1 ls⇩1 sh⇩1 v xa (e∙F{D})
= (True, frs', (None,h⇩1,(v#vs,ls⇩1,C,M,pc+size(compE⇩2 (e∙F{D})),ics)#frs,sh⇩1), err)"
using FAccThrow⇩1.prems(1) by clarsimp
have IH: "PROP ?P e h⇩0 ls⇩0 sh⇩0 (throw e') h⇩1 ls⇩1 sh⇩1 E C M pc ics v xa vs frs I" by fact
show ?case using IH Jcc_pieces_FAcc[OF pcs, of v] FAccThrow⇩1.prems nsub_RI_Jcc_pieces
less_Suc_eq by auto
next
case (FAccNone⇩1 e h⇩0 ls⇩0 sh⇩0 a h⇩1 ls⇩1 sh⇩1 C fs F D)
then obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩1 ls⇩1 sh⇩1 v xa (e∙F{D})
= (True, frs', (None,h⇩1,(v#vs,ls⇩1,C,M,pc+size(compE⇩2 (e∙F{D})),ics)#frs,sh⇩1), err)"
using FAccNone⇩1.prems(1) by clarsimp
have IH: "PROP ?P e h⇩0 ls⇩0 sh⇩0 (addr a) h⇩1 ls⇩1 sh⇩1 E C M pc ics (Addr a) xa vs frs I" by fact
let ?pc = "pc + length(compE⇩2 e)"
let ?xa = "addr_of_sys_xcpt NoSuchFieldError"
have "P ⊢ (None,h⇩0,frs',sh⇩0) -jvm→ (None,h⇩1,(Addr a#vs,ls⇩1,C,M,?pc,ics)#frs,sh⇩1)"
using IH Jcc_pieces_FAcc[OF pcs, of "Addr a"] by simp
also have "P ⊢ … -jvm→ handle P C M ?xa h⇩1 (Addr a#vs) ls⇩1 ?pc ics frs sh⇩1"
using FAccNone⇩1
by(cases ics; clarsimp simp:split_beta handle_def simp del: split_paired_Ex)
finally show ?case using pcs by (auto intro!: exI[where x = ?pc] exI[where x="[Addr a]"])
next
case (FAccStatic⇩1 e h⇩0 ls⇩0 sh⇩0 a h⇩1 ls⇩1 sh⇩1 C' fs F T D)
then obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩1 ls⇩1 sh⇩1 v xa (e∙F{D})
= (True, frs', (None,h⇩1,(v#vs,ls⇩1,C,M,pc+size(compE⇩2 (e∙F{D})),ics)#frs,sh⇩1), err)"
using FAccStatic⇩1.prems(1) by clarsimp
have "P⇩1 ⊢ D sees F,Static:T in D" by(rule has_field_sees[OF has_field_idemp[OF FAccStatic⇩1.hyps(4)]])
then have field: "field P D F = (D,Static,T)" by simp
have IH: "PROP ?P e h⇩0 ls⇩0 sh⇩0 (addr a) h⇩1 ls⇩1 sh⇩1 E C M pc ics (Addr a) xa vs frs I" by fact
let ?pc = "pc + length(compE⇩2 e)"
let ?xa = "addr_of_sys_xcpt IncompatibleClassChangeError"
have "P ⊢ (None,h⇩0,frs',sh⇩0) -jvm→ (None,h⇩1,(Addr a#vs,ls⇩1,C,M,?pc,ics)#frs,sh⇩1)"
using IH Jcc_pieces_FAcc[OF pcs, of "Addr a"] by simp
also have "P ⊢ … -jvm→ handle P C M ?xa h⇩1 (Addr a#vs) ls⇩1 ?pc ics frs sh⇩1"
using FAccStatic⇩1 field by(fastforce simp:split_beta handle_def simp del: split_paired_Ex)
finally show ?case using pcs by (auto intro!: exI[where x = ?pc] exI[where x="[Addr a]"])
next
case (SFAcc⇩1 C' F t D sh sfs v' h ls)
have has: "P⇩1 ⊢ D has F,Static:t in D" by(rule has_field_idemp[OF SFAcc⇩1.hyps(1)])
have "P⇩1 ⊢ D sees F,Static:t in D" by(rule has_field_sees[OF has])
then have field: "field P D F = (D,Static,t)" by simp
then have "P ⊢ (None,h,Jcc_frames P C M vs ls pc ics frs (C'∙⇩sF{D}),sh) -jvm→
(None,h,(v'#vs,ls,C,M,Suc pc,ics)#frs,sh)"
using SFAcc⇩1 has by(cases ics) auto
then show ?case by clarsimp
next
case (SFAccInit⇩1 C' F t D sh h ls v' h' ls' sh' sfs i v'')
then obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h vs ls pc ics frs sh I h' ls' sh' v xa (C'∙⇩sF{D})
= (True, frs', (None,h',(v#vs,ls',C,M,pc+size(compE⇩2 (C'∙⇩sF{D})),ics)#frs,sh'), err)"
using SFAccInit⇩1.prems(1) by clarsimp
have "Ex (WTrt2⇩1 P⇩1 E h sh (INIT D ([D],False) ← unit))"
using has_field_is_class'[OF SFAccInit⇩1.hyps(1)] by auto
then obtain err' where pcs':
"Jcc_pieces P⇩1 E C M h vs ls pc ics frs sh I h' ls' sh' v' xa (INIT D ([D],False) ← unit)
= (True, (vs,ls,C,M,pc,Calling D []) # frs, (None,h',(vs,ls,C,M,pc,Called [])#frs,sh'), err')"
using SFAccInit⇩1.prems(1) by auto
have IH: "PROP ?P (INIT D ([D],False) ← unit) h ls sh (Val v')
h' ls' sh' E C M pc ics v' xa vs frs I" by fact
have ls: "ls = ls'" by(rule init⇩1_same_loc[OF SFAccInit⇩1.hyps(3)])
have has: "P⇩1 ⊢ D has F,Static:t in D" by(rule has_field_idemp[OF SFAccInit⇩1.hyps(1)])
have "P⇩1 ⊢ D sees F,Static:t in D" by(rule has_field_sees[OF has])
then have field: "field P D F = (D,Static,t)" by simp
have "P ⊢ (None,h,(vs,ls,C,M,pc,ics)#frs,sh) -jvm→ (None,h,(vs,ls,C,M,pc,Calling D [])#frs,sh)"
proof(cases "sh D")
case None then show ?thesis using SFAccInit⇩1.hyps(1,2,5,6) SFAccInit⇩1.prems field
by(cases ics) auto
next
case (Some a)
then obtain sfs i where "a = (sfs,i)" by(cases a)
then show ?thesis using SFAccInit⇩1.hyps(1,2,5,6) SFAccInit⇩1.prems field Some
by(cases ics; case_tac i) auto
qed
also have "P ⊢ ... -jvm→ (None, h', (vs, ls, C, M, pc, Called []) # frs, sh')"
using IH pcs' by auto
also have "P ⊢ ... -jvm→ (None, h', (v''#vs, ls, C, M, Suc pc, ics) # frs, sh')"
using SFAccInit⇩1.hyps(1,2,5,6) SFAccInit⇩1.prems has field by(cases ics) auto
finally show ?case using pcs ls by clarsimp
next
case (SFAccInitThrow⇩1 C' F t D sh h ls a h' ls' sh')
obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h vs ls pc ics frs sh I h' ls' sh' v xa (C'∙⇩sF{D})
= (True, frs', (None,h',(v#vs,ls',C,M,pc+size(compE⇩2 (C'∙⇩sF{D})),ics)#frs,sh'), err)"
using SFAccInitThrow⇩1.prems(1) by clarsimp
obtain a' where throw: "throw a = Throw a'" using eval⇩1_final[OF SFAccInitThrow⇩1.hyps(3)] by clarsimp
have "Ex (WTrt2⇩1 P⇩1 E h sh (INIT D ([D],False) ← unit))"
using has_field_is_class'[OF SFAccInitThrow⇩1.hyps(1)] by auto
then obtain vs' where pcs':
"Jcc_pieces P⇩1 E C M h vs ls pc ics frs sh I h' ls' sh' v a' (INIT D ([D],False) ← unit)
= (True, (vs,ls,C,M,pc,Calling D []) # frs, (None,h',(vs,ls,C,M,pc,Called [])#frs,sh'),
P ⊢ (None,h,(vs,ls,C,M,pc,Calling D []) # frs,sh)
-jvm→ handle P C M a' h' (vs'@vs) ls pc ics frs sh')"
using SFAccInitThrow⇩1.prems(1) by simp blast
have IH: "PROP ?P (INIT D ([D],False) ← unit) h ls sh (throw a)
h' ls' sh' E C M pc ics v a' vs frs I" by fact
have ls: "ls = ls'" by(rule init⇩1_same_loc[OF SFAccInitThrow⇩1.hyps(3)])
have has: "P⇩1 ⊢ D has F,Static:t in D" by(rule has_field_idemp[OF SFAccInitThrow⇩1.hyps(1)])
have "P⇩1 ⊢ D sees F,Static:t in D" by(rule has_field_sees[OF has])
then have field: "field P D F = (D,Static,t)" by simp
then have "P ⊢ (None,h,(vs,ls,C,M,pc,ics)#frs,sh) -jvm→ (None,h,(vs,ls,C,M,pc,Calling D []) # frs,sh)"
proof(cases "sh D")
case None then show ?thesis using SFAccInitThrow⇩1.hyps(1,2) SFAccInitThrow⇩1.prems field
by(cases ics) auto
next
case (Some a)
then obtain sfs i where "a = (sfs,i)" by(cases a)
then show ?thesis using SFAccInitThrow⇩1.hyps(1,2) SFAccInitThrow⇩1.prems field Some
by(cases ics; case_tac i) auto
qed
also have "P ⊢ … -jvm→ handle P C M a' h' (vs'@vs) ls pc ics frs sh'"
using IH pcs' throw by auto
finally show ?case using throw ls by auto
next
case (SFAccNone⇩1 C' F D h⇩1 ls⇩1 sh⇩1)
then obtain frs' err where pcs:
"Jcc_pieces P⇩1 E C M h⇩1 vs ls⇩1 pc ics frs sh⇩1 I h⇩1 ls⇩1 sh⇩1 v xa (C'∙⇩sF{D})
= (True, frs', (None,h⇩1,(v#vs,ls⇩1,C,M,pc+size(compE⇩2 (C'∙⇩sF{D})),ics)#frs,sh⇩1), err)"
by clarsimp
let ?xa = "addr_of_sys_xcpt NoSuchFieldError"
have "P ⊢ (None,h⇩1,frs',sh⇩1) -jvm→ handle P C M ?xa h⇩1 vs ls⇩1 pc ics frs sh⇩1"
using SFAccNone⇩1 pcs
by(cases ics; clarsimp simp:split_beta handle_def simp del: split_paired_Ex)
then show ?case using pcs by(auto intro!: exI[where x = pc] exI[where x="[]"])
next
case (SFAccNonStatic⇩1 C' F t D h⇩1 ls⇩1 sh⇩1)
let ?frs' = "(vs, ls⇩1, C, M, pc, ics) # frs"
let ?xa = "addr_of_sys_xcpt IncompatibleClassChangeError"
have "P⇩1 ⊢ D sees F,NonStatic:t in D"
by(rule has_field_sees[OF has_field_idemp[OF SFAccNonStatic⇩1.hyps(1)]])
then have field: "field P D F = (D,NonStatic,t)" by simp
have "P ⊢ (None,h⇩1,?frs',sh⇩1) -jvm→ handle P C M ?xa h⇩1 vs ls⇩1 pc ics frs sh⇩1"
using SFAccNonStatic⇩1
proof(cases ics)
case No_ics
then show ?thesis using SFAccNonStatic⇩1 field
by (auto simp:split_beta handle_def simp del: split_paired_Ex)
qed(simp_all)
then show ?case by (auto intro!: exI[where x = pc] exI[where x="[]"])
next
case (LAss⇩1 e h⇩0 ls⇩0 sh⇩0 w h⇩1 ls⇩1 sh⇩1 i ls⇩2)
let ?pc = "pc + length(compE⇩2 e)"
obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩1 ls⇩1 sh⇩1 v xa (i:=e)
= (True, frs', (None,h⇩1,(v#vs,ls⇩1,C,M,pc+size(compE⇩2 (i:=e)),ics)#frs,sh⇩1), err)"
using LAss⇩1.prems(1) by auto
have IH: "PROP ?P e h⇩0 ls⇩0 sh⇩0 (Val w) h⇩1 ls⇩1 sh⇩1 E C M pc ics w xa vs frs I" by fact
then have "P ⊢ (None,h⇩0,(vs,ls⇩0,C,M,pc,ics)#frs,sh⇩0) -jvm→
(None,h⇩1,(w#vs,ls⇩1,C,M,?pc,ics)#frs,sh⇩1)"
using Jcc_pieces_LAss[OF assms(1) pcs, of w] LAss⇩1.prems pcs by auto
also have "P ⊢ … -jvm→ (None,h⇩1,(Unit#vs,ls⇩2,C,M,?pc+2,ics)#frs,sh⇩1)"
using LAss⇩1 by (auto simp add:cast_ok_def)
finally show ?case by auto
next
case (LAssThrow⇩1 e h⇩0 ls⇩0 sh⇩0 w h⇩1 ls⇩1 sh⇩1 i)
obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩1 ls⇩1 sh⇩1 v xa (i:=e)
= (True, frs', (None,h⇩1,(v#vs,ls⇩1,C,M,pc+size(compE⇩2 (i:=e)),ics)#frs,sh⇩1), err)"
using LAssThrow⇩1.prems(1) by clarsimp
have IH: "PROP ?P e h⇩0 ls⇩0 sh⇩0 (throw w) h⇩1 ls⇩1 sh⇩1 E C M pc ics v xa vs frs I" by fact
show ?case using IH Jcc_pieces_LAss[OF assms(1) pcs, of v] LAssThrow⇩1.prems pcs less_SucI
by(simp, blast)
next
case (FAss⇩1 e⇩1 h⇩0 ls⇩0 sh⇩0 a h⇩1 ls⇩1 sh⇩1 e⇩2 w h⇩2 ls⇩2 sh⇩2 C' fs F T D fs' h⇩2')
obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩2 ls⇩2 sh⇩2 v xa (e⇩1∙F{D} := e⇩2)
= (True, frs', (None,h⇩2,(v#vs,ls⇩2,C,M,pc+size(compE⇩2 (e⇩1∙F{D} := e⇩2)),ics)#frs,sh⇩2), err)"
using FAss⇩1.prems(1) by clarsimp
have "P⇩1 ⊢ D sees F,NonStatic:T in D" by(rule has_field_sees[OF has_field_idemp[OF FAss⇩1.hyps(6)]])
then have field: "field P D F = (D,NonStatic,T)" by simp
let ?pc⇩1 = "pc + length(compE⇩2 e⇩1)"
let ?pc⇩2 = "?pc⇩1 + length(compE⇩2 e⇩2)"
have IH⇩1: "PROP ?P e⇩1 h⇩0 ls⇩0 sh⇩0 (addr a) h⇩1 ls⇩1 sh⇩1 E C M pc ics (Addr a) xa vs frs
(I - pcs (compxE⇩2 e⇩2 (pc + length (compE⇩2 e⇩1)) (Suc (length vs))))" by fact
have IH⇩2: "PROP ?P e⇩2 h⇩1 ls⇩1 sh⇩1 (Val w) h⇩2 ls⇩2 sh⇩2 E C M ?pc⇩1 ics w xa (Addr a#vs) frs
(I - pcs(compxE⇩2 e⇩1 pc (size vs)))" by fact
have "P ⊢ (None,h⇩0,frs',sh⇩0) -jvm→ (None,h⇩1,(Addr a#vs,ls⇩1,C,M,?pc⇩1,ics)#frs,sh⇩1)"
using IH⇩1 Jcc_pieces_FAss1[OF pcs, of h⇩1 ls⇩1 sh⇩1 "Addr a"] by simp
also have "P ⊢ … -jvm→ (None,h⇩2,(w#Addr a#vs,ls⇩2,C,M,?pc⇩2,ics)#frs,sh⇩2)"
using IH⇩2 Jcc_pieces_FAss2[OF pcs, of h⇩1 "Addr a" ls⇩1 sh⇩1 w] by (simp add: add.assoc)
also have "P ⊢ … -jvm→ (None,h⇩2',(Unit#vs,ls⇩2,C,M,?pc⇩2+2,ics)#frs,sh⇩2)"
using FAss⇩1 field by auto
finally show ?case using pcs by (auto simp:add.assoc)
next
case (FAssNull⇩1 e⇩1 h⇩0 ls⇩0 sh⇩0 h⇩1 ls⇩1 sh⇩1 e⇩2 w h⇩2 ls⇩2 sh⇩2 F D)
obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩2 ls⇩2 sh⇩2 v xa (e⇩1∙F{D} := e⇩2)
= (True, frs', (None,h⇩2,(v#vs,ls⇩2,C,M,pc+size(compE⇩2 (e⇩1∙F{D} := e⇩2)),ics)#frs,sh⇩2), err)"
using FAssNull⇩1.prems(1) by clarsimp
let ?pc⇩1 = "pc + length(compE⇩2 e⇩1)"
let ?pc⇩2 = "?pc⇩1 + length(compE⇩2 e⇩2)"
let ?xa = "addr_of_sys_xcpt NullPointer"
have IH⇩1: "PROP ?P e⇩1 h⇩0 ls⇩0 sh⇩0 null h⇩1 ls⇩1 sh⇩1 E C M pc ics Null xa vs frs
(I - pcs (compxE⇩2 e⇩2 (pc + length (compE⇩2 e⇩1)) (Suc (length vs))))" by fact
have IH⇩2: "PROP ?P e⇩2 h⇩1 ls⇩1 sh⇩1 (Val w) h⇩2 ls⇩2 sh⇩2 E C M ?pc⇩1 ics w xa (Null#vs) frs
(I - pcs(compxE⇩2 e⇩1 pc (size vs)))" by fact
have "P ⊢ (None,h⇩0,frs',sh⇩0) -jvm→ (None,h⇩1,(Null#vs,ls⇩1,C,M,?pc⇩1,ics)#frs,sh⇩1)"
using IH⇩1 Jcc_pieces_FAss1[OF pcs, of h⇩1 ls⇩1 sh⇩1 Null] by simp
also have "P ⊢ … -jvm→ (None,h⇩2,(w#Null#vs,ls⇩2,C,M,?pc⇩2,ics)#frs,sh⇩2)"
using IH⇩2 Jcc_pieces_FAss2[OF pcs, of h⇩1 Null ls⇩1 sh⇩1 w] by (simp add: add.assoc)
also have "P ⊢ … -jvm→ handle P C M ?xa h⇩2 (w#Null#vs) ls⇩2 ?pc⇩2 ics frs sh⇩2"
using FAssNull⇩1 by(fastforce simp:split_beta handle_def simp del: split_paired_Ex)
finally show ?case using pcs by (auto intro!: exI[where x = ?pc⇩2] exI[where x="w#[Null]"])
next
case (FAssThrow⇩2⇩1 e⇩1 h⇩0 ls⇩0 sh⇩0 w h⇩1 ls⇩1 sh⇩1 e⇩2 e' h⇩2 ls⇩2 sh⇩2 F D)
let ?frs' = "(vs, ls⇩0, C, M, pc, ics) # frs"
obtain err where pcs: "Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩2 ls⇩2 sh⇩2 v xa (e⇩1∙F{D} := e⇩2)
= (True, ?frs', (None,h⇩2,(v#vs,ls⇩2,C,M,pc+size(compE⇩2 (e⇩1∙F{D} := e⇩2)),ics)#frs,sh⇩2), err)"
using FAssThrow⇩2⇩1.prems(1) by clarsimp
let ?pc⇩1 = "pc + length(compE⇩2 e⇩1)"
let ?σ⇩1 = "(None,h⇩1,(w#vs,ls⇩1,C,M,?pc⇩1,ics)#frs,sh⇩1)"
have IH⇩1: "PROP ?P e⇩1 h⇩0 ls⇩0 sh⇩0 (Val w) h⇩1 ls⇩1 sh⇩1 E C M pc ics w xa vs frs
(I - pcs (compxE⇩2 e⇩2 (pc + length (compE⇩2 e⇩1)) (Suc (length vs))))" by fact
have IH⇩2: "PROP ?P e⇩2 h⇩1 ls⇩1 sh⇩1 (throw e') h⇩2 ls⇩2 sh⇩2 E C M ?pc⇩1 ics v xa (w#vs) frs
(I - pcs(compxE⇩2 e⇩1 pc (size vs)))" by fact
have 1: "P ⊢ (None,h⇩0,?frs',sh⇩0) -jvm→ ?σ⇩1"
using IH⇩1 Jcc_pieces_FAss1[OF pcs, of h⇩1 ls⇩1 sh⇩1 w] by simp
show ?case (is "?N ∧ (?eq ⟶ ?err)")
proof
show ?N by simp
next
{ assume ?eq
moreover
have "PROP ?P e⇩2 h⇩1 ls⇩1 sh⇩1 (throw e') h⇩2 ls⇩2 sh⇩2 E C M ?pc⇩1 ics v xa (w#vs) frs
(I - pcs (compxE⇩2 e⇩1 pc (length vs)))" by fact
ultimately obtain pc⇩2 vs' where
pc⇩2: "?pc⇩1 ≤ pc⇩2 ∧ pc⇩2 < ?pc⇩1 + size(compE⇩2 e⇩2) ∧
¬ caught P pc⇩2 h⇩2 xa (compxE⇩2 e⇩2 ?pc⇩1 (size vs + 1))" and
2: "P ⊢ ?σ⇩1 -jvm→ handle P C M xa h⇩2 (vs'@w#vs) ls⇩2 pc⇩2 ics frs sh⇩2"
using FAssThrow⇩2⇩1.prems Jcc_pieces_FAss2[OF pcs, of h⇩1 w ls⇩1 sh⇩1] by auto
have ?err using Jcc_pieces_FAss2[OF pcs, of h⇩1 w ls⇩1 sh⇩1] pc⇩2 jvm_trans[OF 1 2]
by(auto intro!: exI[where x=pc⇩2] exI[where x="vs'@[w]"])
}
thus "?eq ⟶ ?err" by simp
qed
next
case (FAssThrow⇩1⇩1 e⇩1 h⇩0 ls⇩0 sh⇩0 e' h⇩1 ls⇩1 sh⇩1 F D e⇩2)
obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩1 ls⇩1 sh⇩1 v xa (e⇩1∙F{D} := e⇩2)
= (True, frs', (None,h⇩1,(v#vs,ls⇩1,C,M,pc+size(compE⇩2 (e⇩1∙F{D} := e⇩2)),ics)#frs,sh⇩1), err)"
using FAssThrow⇩1⇩1.prems(1) by clarsimp
have IH⇩1: "PROP ?P e⇩1 h⇩0 ls⇩0 sh⇩0 (throw e') h⇩1 ls⇩1 sh⇩1 E C M pc ics v xa vs frs
(I - pcs (compxE⇩2 e⇩2 (pc + length (compE⇩2 e⇩1)) (Suc (length vs))))" by fact
show ?case using IH⇩1 Jcc_pieces_FAss1[OF pcs, of h⇩1 ls⇩1 sh⇩1 v] FAssThrow⇩1⇩1.prems nsub_RI_Jcc_pieces
by auto
next
case (FAssNone⇩1 e⇩1 h⇩0 ls⇩0 sh⇩0 a h⇩1 ls⇩1 sh⇩1 e⇩2 w h⇩2 ls⇩2 sh⇩2 C' fs F D)
obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩2 ls⇩2 sh⇩2 v xa (e⇩1∙F{D} := e⇩2)
= (True, frs', (None,h⇩2,(v#vs,ls⇩2,C,M,pc+size(compE⇩2 (e⇩1∙F{D} := e⇩2)),ics)#frs,sh⇩2), err)"
using FAssNone⇩1.prems(1) by clarsimp
let ?pc⇩1 = "pc + length(compE⇩2 e⇩1)"
let ?pc⇩2 = "?pc⇩1 + length(compE⇩2 e⇩2)"
let ?xa = "addr_of_sys_xcpt NoSuchFieldError"
have IH⇩1: "PROP ?P e⇩1 h⇩0 ls⇩0 sh⇩0 (addr a) h⇩1 ls⇩1 sh⇩1 E C M pc ics (Addr a) xa vs frs
(I - pcs (compxE⇩2 e⇩2 (pc + length (compE⇩2 e⇩1)) (Suc (length vs))))" by fact
have IH⇩2: "PROP ?P e⇩2 h⇩1 ls⇩1 sh⇩1 (Val w) h⇩2 ls⇩2 sh⇩2 E C M ?pc⇩1 ics w xa (Addr a#vs) frs
(I - pcs(compxE⇩2 e⇩1 pc (size vs)))" by fact
have "P ⊢ (None,h⇩0,frs',sh⇩0) -jvm→ (None,h⇩1,(Addr a#vs,ls⇩1,C,M,?pc⇩1,ics)#frs,sh⇩1)"
using IH⇩1 Jcc_pieces_FAss1[OF pcs, of h⇩1 ls⇩1 sh⇩1 "Addr a"] by simp
also have "P ⊢ … -jvm→ (None,h⇩2,(w#Addr a#vs,ls⇩2,C,M,?pc⇩2,ics)#frs,sh⇩2)"
using IH⇩2 Jcc_pieces_FAss2[OF pcs, of h⇩1 "Addr a" ls⇩1 sh⇩1 w] by (simp add: add.assoc)
also have "P ⊢ … -jvm→ handle P C M ?xa h⇩2 (w#Addr a#vs) ls⇩2 ?pc⇩2 ics frs sh⇩2"
using FAssNone⇩1 by(fastforce simp:split_beta handle_def simp del: split_paired_Ex)
finally show ?case using pcs by (auto intro!: exI[where x = ?pc⇩2] exI[where x="w#[Addr a]"])
next
case (FAssStatic⇩1 e⇩1 h⇩0 ls⇩0 sh⇩0 a h⇩1 ls⇩1 sh⇩1 e⇩2 w h⇩2 ls⇩2 sh⇩2 C' fs F T D)
obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩2 ls⇩2 sh⇩2 v xa (e⇩1∙F{D} := e⇩2)
= (True, frs', (None,h⇩2,(v#vs,ls⇩2,C,M,pc+size(compE⇩2 (e⇩1∙F{D} := e⇩2)),ics)#frs,sh⇩2), err)"
using FAssStatic⇩1.prems(1) by clarsimp
have "P⇩1 ⊢ D sees F,Static:T in D" by(rule has_field_sees[OF has_field_idemp[OF FAssStatic⇩1.hyps(6)]])
then have field: "field P D F = (D,Static,T)" by simp
let ?pc⇩1 = "pc + length(compE⇩2 e⇩1)"
let ?pc⇩2 = "?pc⇩1 + length(compE⇩2 e⇩2)"
let ?xa = "addr_of_sys_xcpt IncompatibleClassChangeError"
have IH⇩1: "PROP ?P e⇩1 h⇩0 ls⇩0 sh⇩0 (addr a) h⇩1 ls⇩1 sh⇩1 E C M pc ics (Addr a) xa vs frs
(I - pcs (compxE⇩2 e⇩2 (pc + length (compE⇩2 e⇩1)) (Suc (length vs))))" by fact
have IH⇩2: "PROP ?P e⇩2 h⇩1 ls⇩1 sh⇩1 (Val w) h⇩2 ls⇩2 sh⇩2 E C M ?pc⇩1 ics w xa (Addr a#vs) frs
(I - pcs(compxE⇩2 e⇩1 pc (size vs)))" by fact
have "P ⊢ (None,h⇩0,frs',sh⇩0) -jvm→ (None,h⇩1,(Addr a#vs,ls⇩1,C,M,?pc⇩1,ics)#frs,sh⇩1)"
using IH⇩1 Jcc_pieces_FAss1[OF pcs, of h⇩1 ls⇩1 sh⇩1 "Addr a"] by simp
also have "P ⊢ … -jvm→ (None,h⇩2,(w#Addr a#vs,ls⇩2,C,M,?pc⇩2,ics)#frs,sh⇩2)"
using IH⇩2 Jcc_pieces_FAss2[OF pcs, of h⇩1 "Addr a" ls⇩1 sh⇩1 w] by (simp add: add.assoc)
also have "P ⊢ … -jvm→ handle P C M ?xa h⇩2 (w#Addr a#vs) ls⇩2 ?pc⇩2 ics frs sh⇩2"
using FAssStatic⇩1 field by(fastforce simp:split_beta handle_def simp del: split_paired_Ex)
finally show ?case using pcs by (auto intro!: exI[where x = ?pc⇩2] exI[where x="w#[Addr a]"])
next
case (SFAss⇩1 e⇩2 h⇩0 ls⇩0 sh⇩0 w h⇩1 ls⇩1 sh⇩1 C' F T D sfs sfs' sh⇩1')
then obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩1 ls⇩1 sh⇩1 v xa (C'∙⇩sF{D} := e⇩2)
= (True, frs', (None,h⇩1,(v#vs,ls⇩1,C,M,pc+size(compE⇩2 (C'∙⇩sF{D} := e⇩2)),ics)#frs,sh⇩1), err)"
using SFAss⇩1.prems(1) by clarsimp
have "P⇩1 ⊢ D sees F,Static:T in D" by(rule has_field_sees[OF has_field_idemp[OF SFAss⇩1.hyps(3)]])
then have field: "field P D F = (D,Static,T)" by simp
have IH: "PROP ?P e⇩2 h⇩0 ls⇩0 sh⇩0 (Val w) h⇩1 ls⇩1 sh⇩1 E C M pc ics w xa vs frs I" by fact
let ?pc = "pc + length(compE⇩2 e⇩2)"
have "P ⊢ (None,h⇩0,frs',sh⇩0) -jvm→ (None,h⇩1,(w#vs,ls⇩1,C,M,?pc,ics)#frs,sh⇩1)"
using IH Jcc_pieces_SFAss[OF pcs, where v'=w] pcs by simp
also have "P ⊢ … -jvm→ (None,h⇩1,(vs,ls⇩1,C,M,?pc+1,ics)#frs,sh⇩1')"
using SFAss⇩1.hyps(3-6) SFAss⇩1.prems(1) field by auto
also have "P ⊢ ... -jvm→ (None,h⇩1,(Unit#vs,ls⇩1,C,M,?pc+2,ics)#frs,sh⇩1')"
using SFAss⇩1 by auto
finally show ?case using pcs by auto
next
case (SFAssInit⇩1 e⇩2 h ls sh w h⇩1 ls⇩1 sh⇩1 C' F t D v' h' ls' sh' sfs i sfs' sh'')
let ?pc = "pc + length(compE⇩2 e⇩2)"
obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h vs ls pc ics frs sh I h' ls' sh'' v xa (C'∙⇩sF{D}:=e⇩2)
= (True, frs', (None,h',(v#vs,ls',C,M,pc+size(compE⇩2 (C'∙⇩sF{D}:=e⇩2)),ics)#frs,sh''), err)"
using SFAssInit⇩1.prems(1) by clarsimp
have "Ex (WTrt2⇩1 P⇩1 E h⇩1 sh⇩1 (INIT D ([D],False) ← unit))"
using has_field_is_class'[OF SFAssInit⇩1.hyps(3)] by auto
then obtain err' where pcs':
"Jcc_pieces P⇩1 E C M h⇩1 (w#vs) ls⇩1 ?pc ics frs sh⇩1 I h' ls' sh' v' xa (INIT D ([D],False) ← unit)
= (True, (w#vs,ls⇩1,C,M,?pc,Calling D []) # frs,
(None,h',(w#vs,ls⇩1,C,M,?pc,Called [])#frs,sh'), err')"
using SFAssInit⇩1.prems(1) by simp
have ls: "ls⇩1 = ls'" by(rule init⇩1_same_loc[OF SFAssInit⇩1.hyps(5)])
have has: "P⇩1 ⊢ D has F,Static:t in D" by(rule has_field_idemp[OF SFAssInit⇩1.hyps(3)])
have "P⇩1 ⊢ D sees F,Static:t in D" by(rule has_field_sees[OF has])
then have field: "field P D F = (D,Static,t)" by simp
have IH: "PROP ?P e⇩2 h ls sh (Val w) h⇩1 ls⇩1 sh⇩1 E C M pc ics w xa vs frs I" by fact
have IHI: "PROP ?P (INIT D ([D],False) ← unit) h⇩1 ls⇩1 sh⇩1 (Val v')
h' ls' sh' E C M ?pc ics v' xa (w#vs) frs I" by fact
have "P ⊢ (None,h,frs',sh) -jvm→ (None,h⇩1,(w#vs,ls⇩1,C,M,?pc,ics)#frs,sh⇩1)"
using IH Jcc_pieces_SFAss[OF pcs, where v'=w] by simp
also have "P ⊢ … -jvm→ (None,h⇩1,(w#vs,ls⇩1,C,M,?pc,Calling D [])#frs,sh⇩1)"
proof(cases "sh⇩1 D")
case None then show ?thesis using None SFAssInit⇩1.hyps(1,3-5,7-9) SFAssInit⇩1.prems field
by(cases ics, auto)
next
case (Some a)
then obtain sfs i where "a = (sfs,i)" by(cases a)
then show ?thesis using SFAssInit⇩1.hyps(1,3-5,7-9) SFAssInit⇩1.prems field Some
by(cases ics; case_tac i) auto
qed
also have "P ⊢ ... -jvm→ (None, h', (w#vs, ls⇩1, C, M, ?pc, Called []) # frs, sh')"
using IHI pcs' by clarsimp
also have "P ⊢ ... -jvm→ (None, h', (vs, ls⇩1, C, M, ?pc + 1, ics) # frs, sh'')"
using SFAssInit⇩1.hyps(1,3-5,7-9) SFAssInit⇩1.prems has field by(cases ics) auto
also have "P ⊢ ... -jvm→ (None, h', (Unit#vs, ls⇩1, C, M, ?pc + 2, ics) # frs, sh'')"
using SFAssInit⇩1.hyps(1,3-5,7-9) SFAssInit⇩1.prems has field by(cases ics) auto
finally show ?case using pcs ls by simp blast
next
case (SFAssInitThrow⇩1 e⇩2 h ls sh w h⇩1 ls⇩1 sh⇩1 C' F t D a h' ls' sh')
let ?pc = "pc + length(compE⇩2 e⇩2)"
obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h vs ls pc ics frs sh I h' ls' sh' v xa (C'∙⇩sF{D}:=e⇩2)
= (True, frs', (None,h',(v#vs,ls',C,M,pc+size(compE⇩2 (C'∙⇩sF{D}:=e⇩2)),ics)#frs,sh'), err)"
using SFAssInitThrow⇩1.prems(1) by clarsimp
obtain a' where throw: "throw a = Throw a'" using eval⇩1_final[OF SFAssInitThrow⇩1.hyps(5)] by clarsimp
have "Ex (WTrt2⇩1 P⇩1 E h⇩1 sh⇩1 (INIT D ([D],False) ← unit))"
using has_field_is_class'[OF SFAssInitThrow⇩1.hyps(3)] by auto
then obtain vs' where pcs':
"Jcc_pieces P⇩1 E C M h⇩1 (w#vs) ls⇩1 ?pc ics frs sh⇩1 I h' ls' sh' v a' (INIT D ([D],False) ← unit)
= (True, (w#vs,ls⇩1,C,M,?pc,Calling D []) # frs, (None,h',(w#vs,ls⇩1,C,M,?pc,Called [])#frs,sh'),
P ⊢ (None,h⇩1,(w#vs,ls⇩1,C,M,?pc,Calling D []) # frs,sh⇩1)
-jvm→ handle P C M a' h' (vs'@w#vs) ls⇩1 ?pc ics frs sh')"
using SFAssInitThrow⇩1.prems(1) by simp blast
have ls: "ls⇩1 = ls'" by(rule init⇩1_same_loc[OF SFAssInitThrow⇩1.hyps(5)])
have has: "P⇩1 ⊢ D has F,Static:t in D" by(rule has_field_idemp[OF SFAssInitThrow⇩1.hyps(3)])
have "P⇩1 ⊢ D sees F,Static:t in D" by(rule has_field_sees[OF has])
then have field: "field P D F = (D,Static,t)" by simp
have IH: "PROP ?P e⇩2 h ls sh (Val w) h⇩1 ls⇩1 sh⇩1 E C M pc ics w xa vs frs I" by fact
have IHI: "PROP ?P (INIT D ([D],False) ← unit) h⇩1 ls⇩1 sh⇩1 (throw a)
h' ls' sh' E C M ?pc ics v a' (w#vs) frs I" by fact
have "P ⊢ (None,h,(vs, ls, C, M, pc, ics) # frs,sh) -jvm→ (None,h⇩1,(w#vs,ls⇩1,C,M,?pc,ics)#frs,sh⇩1)"
using IH Jcc_pieces_SFAss[OF pcs, where v'=w] pcs by simp blast
also have "P ⊢ … -jvm→ (None,h⇩1,(w#vs,ls⇩1,C,M,?pc,Calling D [])#frs,sh⇩1)"
proof(cases "sh⇩1 D")
case None then show ?thesis using SFAssInitThrow⇩1.hyps(1,3,4,5) SFAssInitThrow⇩1.prems field
by(cases ics) auto
next
case (Some a)
then obtain sfs i where "a = (sfs,i)" by(cases a)
then show ?thesis using SFAssInitThrow⇩1.hyps(1,3,4,5) SFAssInitThrow⇩1.prems field Some
by(cases ics; case_tac i) auto
qed
also have "P ⊢ ... -jvm→ handle P C M a' h' (vs'@w#vs) ls⇩1 ?pc ics frs sh'"
using IHI pcs' throw by auto
finally show ?case using throw ls by(auto intro!: exI[where x = ?pc] exI[where x="vs'@[w]"])
next
case (SFAssThrow⇩1 e⇩2 h⇩0 ls⇩0 sh⇩0 e' h⇩1 ls⇩1 sh⇩1 C' F D)
then obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩1 ls⇩1 sh⇩1 v xa (C'∙⇩sF{D} := e⇩2)
= (True, frs', (None,h⇩1,(v#vs,ls⇩1,C,M,pc+size(compE⇩2 (C'∙⇩sF{D} := e⇩2)),ics)#frs,sh⇩1), err)"
using SFAssThrow⇩1.prems(1) by clarsimp
have IH: "PROP ?P e⇩2 h⇩0 ls⇩0 sh⇩0 (throw e') h⇩1 ls⇩1 sh⇩1 E C M pc ics v xa vs frs I" by fact
show ?case using IH Jcc_pieces_SFAss[OF pcs, where v'=v] SFAssThrow⇩1.prems nsub_RI_Jcc_pieces
less_Suc_eq by auto
next
case (SFAssNone⇩1 e⇩2 h⇩0 ls⇩0 sh⇩0 w h⇩1 ls⇩1 sh⇩1 C' F D)
then obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩1 ls⇩1 sh⇩1 v xa (C'∙⇩sF{D} := e⇩2)
= (True, frs', (None,h⇩1,(v#vs,ls⇩1,C,M,pc+size(compE⇩2 (C'∙⇩sF{D} := e⇩2)),ics)#frs,sh⇩1), err)"
using SFAssNone⇩1.prems(1) by clarsimp
have IH: "PROP ?P e⇩2 h⇩0 ls⇩0 sh⇩0 (Val w) h⇩1 ls⇩1 sh⇩1 E C M pc ics w xa vs frs I" by fact
let ?pc = "pc + length(compE⇩2 e⇩2)"
let ?xa = "addr_of_sys_xcpt NoSuchFieldError"
have "P ⊢ (None,h⇩0,frs',sh⇩0) -jvm→ (None,h⇩1,(w#vs,ls⇩1,C,M,?pc,ics)#frs,sh⇩1)"
using IH Jcc_pieces_SFAss[OF pcs, where v'=w] pcs by simp
also have "P ⊢ … -jvm→ handle P C M ?xa h⇩1 (w#vs) ls⇩1 ?pc ics frs sh⇩1"
using SFAssNone⇩1 by(cases ics; clarsimp simp add: handle_def)
finally show ?case using pcs by (auto intro!: exI[where x = ?pc] exI[where x="[w]"])
next
case (SFAssNonStatic⇩1 e⇩2 h⇩0 ls⇩0 sh⇩0 w h⇩1 ls⇩1 sh⇩1 C' F T D)
then obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩1 ls⇩1 sh⇩1 v xa (C'∙⇩sF{D} := e⇩2)
= (True, frs', (None,h⇩1,(v#vs,ls⇩1,C,M,pc+size(compE⇩2 (C'∙⇩sF{D} := e⇩2)),ics)#frs,sh⇩1), err)"
using SFAssNonStatic⇩1.prems(1) by clarsimp
have IH: "PROP ?P e⇩2 h⇩0 ls⇩0 sh⇩0 (Val w) h⇩1 ls⇩1 sh⇩1 E C M pc ics w xa vs frs I" by fact
let ?pc = "pc + length(compE⇩2 e⇩2)"
let ?xa = "addr_of_sys_xcpt IncompatibleClassChangeError"
have "P⇩1 ⊢ D sees F,NonStatic:T in D"
by(rule has_field_sees[OF has_field_idemp[OF SFAssNonStatic⇩1.hyps(3)]])
then have field: "field P D F = (D,NonStatic,T)" by simp
have "P ⊢ (None,h⇩0,frs',sh⇩0) -jvm→ (None,h⇩1,(w#vs,ls⇩1,C,M,?pc,ics)#frs,sh⇩1)"
using IH Jcc_pieces_SFAss[OF pcs, where v'=w] pcs by simp
also have "P ⊢ … -jvm→ handle P C M ?xa h⇩1 (w#vs) ls⇩1 ?pc ics frs sh⇩1"
using SFAssNonStatic⇩1
proof(cases ics)
case No_ics
then show ?thesis using SFAssNonStatic⇩1 field
by (auto simp:split_beta handle_def simp del: split_paired_Ex)
qed(simp_all)
finally show ?case using pcs by (auto intro!: exI[where x = ?pc] exI[where x="[w]"])
next
case (Call⇩1 e h⇩0 ls⇩0 sh⇩0 a h⇩1 ls⇩1 sh⇩1 es pvs h⇩2 ls⇩2 sh⇩2 Ca fs M' Ts T body D ls⇩2' f h⇩3 ls⇩3 sh⇩3)
let ?frs⇩0 = "(vs, ls⇩0, C,M,pc,ics)#frs"
let ?σ⇩0 = "(None,h⇩0,?frs⇩0,sh⇩0)"
let ?pc⇩1 = "pc + length(compE⇩2 e)"
let ?σ⇩1 = "(None,h⇩1,(Addr a#vs, ls⇩1, C,M,?pc⇩1,ics)#frs,sh⇩1)"
let ?pc⇩2 = "?pc⇩1 + length(compEs⇩2 es)"
let ?frs⇩2 = "(rev pvs @ Addr a # vs, ls⇩2, C,M,?pc⇩2,ics)#frs"
let ?σ⇩2 = "(None,h⇩2,?frs⇩2,sh⇩2)"
let ?frs⇩2' = "([], ls⇩2', D,M',0,No_ics) # ?frs⇩2"
let ?σ⇩2' = "(None, h⇩2, ?frs⇩2', sh⇩2)"
have nclinit: "M' ≠ clinit" using wf_sees_clinit1[OF wf] visible_method_exists[OF Call⇩1.hyps(6)]
sees_method_idemp[OF Call⇩1.hyps(6)] by fastforce
have "P⇩1 ⊢⇩1 ⟨es,(h⇩1, ls⇩1, sh⇩1)⟩ [⇒] ⟨map Val pvs,(h⇩2, ls⇩2, sh⇩2)⟩" by fact
hence [simp]: "length es = length pvs" by(auto dest:evals⇩1_preserves_elen)
have invoke: "P,C,M,?pc⇩2 ▹ Invoke M' (length Ts)"
using Call⇩1.hyps(7) Call⇩1.prems(1) by clarsimp
have nsub: "¬ sub_RI body" by(rule sees_wf⇩1_nsub_RI[OF wf Call⇩1.hyps(6)])
obtain err where pcs:
"Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩3 ls⇩2 sh⇩3 v xa (e∙M'(es)) =
(True, ?frs⇩0, (None, h⇩3, (v#vs, ls⇩2, C,M,?pc⇩2+1,ics)#frs,sh⇩3), err)"
using Call⇩1.prems(1) by clarsimp
have IH: "PROP ?P e h⇩0 ls⇩0 sh⇩0 (addr a) h⇩1 ls⇩1 sh⇩1 E C M pc ics (Addr a) xa vs frs
(I - pcs (compxEs⇩2 es (pc + length (compE⇩2 e)) (Suc (length vs))))" by fact
have IH_es: "PROP ?Ps es h⇩1 ls⇩1 sh⇩1 (map Val pvs) h⇩2 ls⇩2 sh⇩2 C M ?pc⇩1 ics pvs xa
(map Val pvs) (Addr a#vs) frs (I - pcs(compxE⇩2 e pc (size vs)))" by fact
have "P ⊢ ?σ⇩0 -jvm→ ?σ⇩1" using Jcc_pieces_Call1[OF pcs] IH by clarsimp
also have "P ⊢ … -jvm→ ?σ⇩2" using IH_es Call⇩1.prems by fastforce
also have "P ⊢ … -jvm→ ?σ⇩2'"
using jvm_Invoke[OF assms(1) invoke _ Call⇩1.hyps(6-8)] Call⇩1.hyps(5) Call⇩1.prems(1) by simp
finally have 1: "P ⊢ ?σ⇩0 -jvm→ ?σ⇩2'".
have "P⇩1 ⊢ Ca sees M',NonStatic: Ts→T = body in D" by fact
then have M'_in_D: "P⇩1 ⊢ D sees M',NonStatic: Ts→T = body in D"
by(rule sees_method_idemp)
have M'_code: "compP⇩2 P⇩1,D,M',0 ⊳ compE⇩2 body @ [Return]" using beforeM M'_in_D by simp
have M'_xtab: "compP⇩2 P⇩1,D,M' ⊳ compxE⇩2 body 0 0/{..<size(compE⇩2 body)},0"
using M'_in_D by(rule beforexM)
have IH_body: "PROP ?P body h⇩2 ls⇩2' sh⇩2 f h⇩3 ls⇩3 sh⇩3 (Class D # Ts) D M' 0 No_ics v xa [] ?frs⇩2
({..<size(compE⇩2 body)})" by fact
have cond: "Jcc_cond P⇩1 (Class D # Ts) D M' [] 0 No_ics {..<length (compE⇩2 body)} h⇩2 sh⇩2 body"
using nsub_RI_Jcc_pieces[OF assms(1) nsub] M'_code M'_xtab by clarsimp
show ?case (is "?Norm ∧ ?Err")
proof
show ?Norm (is "?val ⟶ ?trans")
proof
assume val: ?val
note 1
also have "P ⊢ ?σ⇩2' -jvm→ (None,h⇩3,([v],ls⇩3,D,M',size(compE⇩2 body),No_ics)#?frs⇩2,sh⇩3)"
using val IH_body Call⇩1.prems M'_code cond nsub_RI_Jcc_pieces nsub by auto
also have "P ⊢ … -jvm→ (None, h⇩3, (v#vs, ls⇩2, C,M,?pc⇩2+1,ics)#frs,sh⇩3)"
using Call⇩1.hyps(7) M'_code M'_in_D nclinit by(cases T, auto)
finally show ?trans by(simp add:add.assoc)
qed
next
show ?Err (is "?throw ⟶ ?err")
proof
assume throw: ?throw
with IH_body obtain pc⇩2 vs' where
pc⇩2: "0 ≤ pc⇩2 ∧ pc⇩2 < size(compE⇩2 body) ∧
¬ caught P pc⇩2 h⇩3 xa (compxE⇩2 body 0 0)" and
2: "P ⊢ ?σ⇩2' -jvm→ handle P D M' xa h⇩3 vs' ls⇩3 pc⇩2 No_ics ?frs⇩2 sh⇩3"
using Call⇩1.prems M'_code M'_xtab cond nsub_RI_Jcc_pieces nsub
by (auto simp del:split_paired_Ex)
have "handle P D M' xa h⇩3 vs' ls⇩3 pc⇩2 No_ics ?frs⇩2 sh⇩3 =
handle P C M xa h⇩3 (rev pvs @ Addr a # vs) ls⇩2 ?pc⇩2 ics frs sh⇩3"
using pc⇩2 M'_in_D nclinit by(auto simp add:handle_def)
then show "?err" using pc⇩2 jvm_trans[OF 1 2]
by(auto intro!:exI[where x="?pc⇩2"] exI[where x="rev pvs@[Addr a]"])
qed
qed
next
case (CallParamsThrow⇩1 e h⇩0 ls⇩0 sh⇩0 w h⇩1 ls⇩1 sh⇩1 es es' h⇩2 ls⇩2 sh⇩2 pvs ex es'' M')
let ?frs⇩0 = "(vs, ls⇩0, C,M,pc,ics)#frs"
let ?σ⇩0 = "(None,h⇩0,(vs, ls⇩0, C,M,pc,ics)#frs,sh⇩0)"
let ?pc⇩1 = "pc + length(compE⇩2 e)"
let ?σ⇩1 = "(None,h⇩1,(w # vs, ls⇩1, C,M,?pc⇩1,ics)#frs,sh⇩1)"
let ?pc⇩2 = "?pc⇩1 + length(compEs⇩2 es)"
obtain err where pcs:
"Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩2 ls⇩2 sh⇩2 v xa (e∙M'(es)) =
(True, ?frs⇩0, (None, h⇩2, (v#vs, ls⇩2, C,M,?pc⇩2+1,ics)#frs,sh⇩2), err)"
using CallParamsThrow⇩1.prems(1) by clarsimp
have IH: "PROP ?P e h⇩0 ls⇩0 sh⇩0 (Val w) h⇩1 ls⇩1 sh⇩1 E C M pc ics w xa vs frs
(I - pcs (compxEs⇩2 es (pc + length (compE⇩2 e)) (Suc (length vs))))" by fact
have 1: "P ⊢ ?σ⇩0 -jvm→ ?σ⇩1" using Jcc_pieces_Call1[OF pcs] IH by clarsimp
have Isubs: "{?pc⇩1..<?pc⇩2} ⊆ I - pcs (compxE⇩2 e pc (length vs))"
using CallParamsThrow⇩1.prems by clarsimp
show ?case (is "?N ∧ (?eq ⟶ ?err)")
proof
show ?N by simp
next
{ assume ?eq
moreover
have "PROP ?Ps es h⇩1 ls⇩1 sh⇩1 es' h⇩2 ls⇩2 sh⇩2 C M ?pc⇩1 ics pvs xa es'' (w#vs) frs
(I - pcs (compxE⇩2 e pc (length vs)))" by fact
ultimately obtain vs' where "∃pc⇩2.
(?pc⇩1 ≤ pc⇩2 ∧ pc⇩2 < ?pc⇩1 + size(compEs⇩2 es) ∧
¬ caught P pc⇩2 h⇩2 xa (compxEs⇩2 es ?pc⇩1 (size vs + 1))) ∧
P ⊢ ?σ⇩1 -jvm→ handle P C M xa h⇩2 (vs'@w#vs) ls⇩2 pc⇩2 ics frs sh⇩2"
(is "∃pc⇩2. ?PC pc⇩2 ∧ ?Exec pc⇩2")
using CallParamsThrow⇩1 Isubs by auto
then obtain pc⇩2 where pc⇩2: "?PC pc⇩2" and 2: "?Exec pc⇩2" by iprover
then have "?err" using pc⇩2 jvm_trans[OF 1 2]
by(auto intro!: exI[where x="pc⇩2"] exI[where x="vs'@[w]"])
}
thus "?eq ⟶ ?err" by simp
qed
next
case (CallNull⇩1 e h⇩0 ls⇩0 sh⇩0 h⇩1 ls⇩1 sh⇩1 es pvs h⇩2 ls⇩2 sh⇩2 M')
have "P⇩1 ⊢⇩1 ⟨es,(h⇩1, ls⇩1, sh⇩1)⟩ [⇒] ⟨map Val pvs,(h⇩2, ls⇩2, sh⇩2)⟩" by fact
hence [simp]: "length es = length pvs" by(auto dest:evals⇩1_preserves_elen)
let ?frs⇩0 = "(vs, ls⇩0, C,M,pc,ics)#frs"
let ?pc⇩1 = "pc + length(compE⇩2 e)"
let ?pc⇩2 = "?pc⇩1 + length(compEs⇩2 es)"
let ?xa = "addr_of_sys_xcpt NullPointer"
obtain err where pcs:
"Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩2 ls⇩2 sh⇩2 v xa (e∙M'(es)) =
(True, ?frs⇩0, (None, h⇩2, (v#vs, ls⇩2, C,M,?pc⇩2+1,ics)#frs,sh⇩2), err)"
using CallNull⇩1.prems(1) by clarsimp
have IH: "PROP ?P e h⇩0 ls⇩0 sh⇩0 null h⇩1 ls⇩1 sh⇩1 E C M pc ics Null xa vs frs
(I - pcs (compxEs⇩2 es (pc + length (compE⇩2 e)) (Suc (length vs))))" by fact
have IH_es: "PROP ?Ps es h⇩1 ls⇩1 sh⇩1 (map Val pvs) h⇩2 ls⇩2 sh⇩2 C M ?pc⇩1 ics pvs xa
(map Val pvs) (Null#vs) frs (I - pcs(compxE⇩2 e pc (size vs)))" by fact
have Isubs: "{pc + length (compE⇩2 e)..<pc + length (compE⇩2 e) + length (compEs⇩2 es)}
⊆ I - pcs (compxE⇩2 e pc (length vs))" using CallNull⇩1.prems by clarsimp
have "P ⊢ (None,h⇩0,(vs,ls⇩0,C,M,pc,ics)#frs,sh⇩0) -jvm→
(None,h⇩1,(Null#vs,ls⇩1,C,M,?pc⇩1,ics)#frs,sh⇩1)"
using Jcc_pieces_Call1[OF pcs] IH by clarsimp
also have "P ⊢ … -jvm→ (None,h⇩2,(rev pvs@Null#vs,ls⇩2,C,M,?pc⇩2,ics)#frs,sh⇩2)"
using CallNull⇩1 IH_es Isubs by auto
also have "P ⊢ … -jvm→ handle P C M ?xa h⇩2 (rev pvs@Null#vs) ls⇩2 ?pc⇩2 ics frs sh⇩2"
using CallNull⇩1.prems
by(auto simp:split_beta handle_def nth_append simp del: split_paired_Ex)
finally show ?case by (auto intro!: exI[where x = ?pc⇩2] exI[where x="rev pvs@[Null]"])
next
case (CallObjThrow⇩1 e h ls sh e' h' ls' sh' M' es)
obtain err where pcs:
"Jcc_pieces P⇩1 E C M h vs ls pc ics frs sh I h' ls' sh' v xa (e∙M'(es)) =
(True, (vs, ls, C,M,pc,ics)#frs,
(None, h', (v#vs, ls', C,M,pc+size(compE⇩2 (e∙M'(es))),ics)#frs,sh'), err)"
using CallObjThrow⇩1.prems(1) by clarsimp
obtain a' where throw: "throw e' = Throw a'"
using eval⇩1_final[OF CallObjThrow⇩1.hyps(1)] by clarsimp
have IH: "PROP ?P e h ls sh (throw e') h' ls' sh' E C M pc ics v a' vs frs
(I - pcs (compxEs⇩2 es (pc + length (compE⇩2 e)) (Suc (length vs))))" by fact
show ?case using IH Jcc_pieces_Call1[OF pcs] throw CallObjThrow⇩1.prems nsub_RI_Jcc_pieces
by auto
next
case (CallNone⇩1 e h⇩0 ls⇩0 sh⇩0 a h⇩1 ls⇩1 sh⇩1 es pvs h⇩2 ls⇩2 sh⇩2 C' fs M')
let ?frs⇩0 = "(vs, ls⇩0, C,M,pc,ics)#frs"
let ?σ⇩0 = "(None,h⇩0,?frs⇩0,sh⇩0)"
let ?pc⇩1 = "pc + length(compE⇩2 e)"
let ?σ⇩1 = "(None,h⇩1,(Addr a#vs, ls⇩1, C,M,?pc⇩1,ics)#frs,sh⇩1)"
let ?pc⇩2 = "?pc⇩1 + length(compEs⇩2 es)"
let ?frs⇩2 = "(rev pvs @ Addr a # vs, ls⇩2, C,M,?pc⇩2,ics)#frs"
let ?σ⇩2 = "(None,h⇩2,?frs⇩2,sh⇩2)"
let ?xa = "addr_of_sys_xcpt NoSuchMethodError"
have "P⇩1 ⊢⇩1 ⟨es,(h⇩1, ls⇩1, sh⇩1)⟩ [⇒] ⟨map Val pvs,(h⇩2, ls⇩2, sh⇩2)⟩" by fact
hence [simp]: "length es = length pvs" by(auto dest:evals⇩1_preserves_elen)
have aux: "(rev pvs @ Addr a # vs) ! length pvs = Addr a"
by (metis length_rev nth_append_length)
have nmeth: "¬(∃b Ts T body D. P ⊢ C' sees M', b : Ts→T = body in D)"
using sees_method_compPD CallNone⇩1.hyps(6) by fastforce
obtain err where pcs:
"Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩2 ls⇩2 sh⇩2 v xa (e∙M'(es)) =
(True, ?frs⇩0, (None, h⇩2, (v#vs, ls⇩2, C,M,?pc⇩2+1,ics)#frs,sh⇩2), err)"
using CallNone⇩1.prems(1) by clarsimp
have IH: "PROP ?P e h⇩0 ls⇩0 sh⇩0 (addr a) h⇩1 ls⇩1 sh⇩1 E C M pc ics (Addr a) xa vs frs
(I - pcs (compxEs⇩2 es (pc + length (compE⇩2 e)) (Suc (length vs))))" by fact
have IH_es: "PROP ?Ps es h⇩1 ls⇩1 sh⇩1 (map Val pvs) h⇩2 ls⇩2 sh⇩2 C M ?pc⇩1 ics pvs xa
(map Val pvs) (Addr a#vs) frs (I - pcs(compxE⇩2 e pc (size vs)))" by fact
have "P ⊢ ?σ⇩0 -jvm→ ?σ⇩1" using Jcc_pieces_Call1[OF pcs] IH by clarsimp
also have "P ⊢ … -jvm→ ?σ⇩2" using IH_es CallNone⇩1.prems by fastforce
also have "P ⊢ … -jvm→ handle P C M ?xa h⇩2 (rev pvs@Addr a#vs) ls⇩2 ?pc⇩2 ics frs sh⇩2"
using CallNone⇩1.hyps(5) CallNone⇩1.prems aux nmeth
by(cases "method P C' M'", cases "find_handler P ?xa h⇩2 frs sh⇩2", auto simp: handle_def)
finally show ?case using pcs by (auto intro!: exI[where x = ?pc⇩2] exI[where x="rev pvs@[Addr a]"])
next
case (CallStatic⇩1 e h⇩0 ls⇩0 sh⇩0 a h⇩1 ls⇩1 sh⇩1 es pvs h⇩2 ls⇩2 sh⇩2 C' fs M' Ts T body D)
let ?frs⇩0 = "(vs, ls⇩0, C,M,pc,ics)#frs"
let ?σ⇩0 = "(None,h⇩0,?frs⇩0,sh⇩0)"
let ?pc⇩1 = "pc + length(compE⇩2 e)"
let ?σ⇩1 = "(None,h⇩1,(Addr a#vs, ls⇩1, C,M,?pc⇩1,ics)#frs,sh⇩1)"
let ?pc⇩2 = "?pc⇩1 + length(compEs⇩2 es)"
let ?frs⇩2 = "(rev pvs @ Addr a # vs, ls⇩2, C,M,?pc⇩2,ics)#frs"
let ?σ⇩2 = "(None,h⇩2,?frs⇩2,sh⇩2)"
let ?xa = "addr_of_sys_xcpt IncompatibleClassChangeError"
have "P⇩1 ⊢⇩1 ⟨es,(h⇩1, ls⇩1, sh⇩1)⟩ [⇒] ⟨map Val pvs,(h⇩2, ls⇩2, sh⇩2)⟩" by fact
hence [simp]: "length es = length pvs" by(auto dest:evals⇩1_preserves_elen)
have aux: "(rev pvs @ Addr a # vs) ! length pvs = Addr a"
by (metis length_rev nth_append_length)
obtain body' where method: "P ⊢ C' sees M', Static : Ts→T = body' in D"
by (metis CallStatic⇩1.hyps(6) P_def compP⇩2_def sees_method_compP)
obtain err where pcs:
"Jcc_pieces P⇩1 E C M h⇩0 vs ls⇩0 pc ics frs sh⇩0 I h⇩2 ls⇩2 sh⇩2 v xa (e∙M'(es)) =
(True, ?frs⇩0, (None, h⇩2, (v#vs, ls⇩2, C,M,?pc⇩2+1,ics)#frs,sh⇩2), err)"
using CallStatic⇩1.prems(1) by clarsimp
have IH: "PROP ?P e h⇩0 ls⇩0 sh⇩0 (addr a) h⇩1 ls⇩1 sh⇩1 E C M pc ics (Addr a) xa vs frs
(I - pcs (compxEs⇩2 es (pc + length (compE⇩2 e)) (Suc (length vs))))" by fact
have IH_es: "PROP ?Ps es h⇩1 ls⇩1 sh⇩1 (map Val pvs) h⇩2 ls⇩2 sh⇩2 C M ?pc⇩1 ics pvs xa
(map Val pvs) (Addr a#vs) frs (I - pcs(compxE⇩2 e pc (size vs)))" by fact
have "P ⊢ ?σ⇩0 -jvm→ ?σ⇩1" using Jcc_pieces_Call1[OF pcs] IH by clarsimp
also have "P ⊢ … -jvm→ ?σ⇩2" using IH_es CallStatic⇩1.prems by fastforce
also have "P ⊢ … -jvm→ handle P C M ?xa h⇩2 (rev pvs@Addr a#vs) ls⇩2 ?pc⇩2 ics frs sh⇩2"
using CallStatic⇩1.hyps(5) CallStatic⇩1.prems aux method
by(cases "method P C' M'", cases "find_handler P ?xa h⇩2 frs sh⇩2")
(auto simp: handle_def; meson frames_of.cases)
finally show ?case using pcs by (auto intro!: exI[where x = ?pc⇩2] exI[where x="rev pvs@[Addr a]"])
next
case (SCallParamsThrow⇩1 es h⇩1 ls⇩1 sh⇩1 es' h⇩2 ls⇩2 sh⇩2 pvs ex es'' C' M')
show ?case
proof(cases "M' = clinit ∧ es = []")
case clinit: True then show ?thesis
using SCallParamsThrow⇩1.hyps(1,3) evals⇩1_cases(1) by fastforce
next
case nclinit: False
let ?σ⇩1 = "(None,h⇩1,(vs, ls⇩1, C,M,pc,ics)#frs,sh⇩1)"
let ?pc⇩2 = "pc + length(compEs⇩2 es)"
have Isubs: "{pc..<pc + length (compEs⇩2 es)} ⊆ I" using SCallParamsThrow⇩1.prems nclinit by clarsimp
show ?thesis (is "?N ∧ (?eq ⟶ ?err)")
proof
show ?N by simp
next
{ assume ?eq
moreover
have "PROP ?Ps es h⇩1 ls⇩1 sh⇩1 es' h⇩2 ls⇩2 sh⇩2 C M pc ics pvs xa es'' vs frs I" by fact
ultimately have "∃pc⇩2.
(pc ≤ pc⇩2 ∧ pc⇩2 < pc + size(compEs⇩2 es) ∧
¬ caught P pc⇩2 h⇩2 xa (compxEs⇩2 es pc (size vs))) ∧
(∃vs'. P ⊢ ?σ⇩1 -jvm→ handle P C M xa h⇩2 (vs'@vs) ls⇩2 pc⇩2 ics frs sh⇩2)"
(is "∃pc⇩2. ?PC pc⇩2 ∧ ?Exec pc⇩2")
using SCallParamsThrow⇩1 Isubs nclinit by auto
then obtain pc⇩2 where pc⇩2: "?PC pc⇩2" and 2: "?Exec pc⇩2" by iprover
then have "?err" using pc⇩2 2 by(auto intro: exI[where x="pc⇩2"])
}
thus "?eq ⟶ ?err" by iprover
qed
qed
next
case (SCallNone⇩1 es h⇩1 ls⇩1 sh⇩1 pvs h⇩2 ls⇩2 sh⇩2 C' M')
show ?case
proof(cases "M' = clinit ∧ es = []")
case clinit: True then show ?thesis using SCallNone⇩1.hyps(3) SCallNone⇩1.prems by auto
next
case nclinit: False
let ?σ⇩1 = "(None,h⇩1,(vs, ls⇩1, C,M,pc,ics)#frs,sh⇩1)"
let ?pc⇩2 = "pc + length(compEs⇩2 es)"
let ?frs⇩2 = "(rev pvs @ vs, ls⇩2, C,M,?pc⇩2,ics)#frs"
let ?σ⇩2 = "(None,h⇩2,?frs⇩2,sh⇩2)"
let ?xa = "addr_of_sys_xcpt NoSuchMethodError"
have "P⇩1 ⊢⇩1 ⟨es,(h⇩1, ls⇩1, sh⇩1)⟩ [⇒] ⟨map Val pvs,(h⇩2, ls⇩2, sh⇩2)⟩" by fact
hence [simp]: "length es = length pvs" by(auto dest:evals⇩1_preserves_elen)
have nmeth: "¬(∃b Ts T body D. P ⊢ C' sees M', b : Ts→T = body in D)"
using sees_method_compPD SCallNone⇩1.hyps(3) by fastforce
have IH_es: "PROP ?Ps es h⇩1 ls⇩1 sh⇩1 (map Val pvs) h⇩2 ls⇩2 sh⇩2 C M pc ics pvs xa
(map Val pvs) vs frs I" by fact
have "P ⊢ ?σ⇩1 -jvm→ ?σ⇩2" using IH_es SCallNone⇩1.prems nclinit by auto fastforce+
also have "P ⊢ … -jvm→ handle P C M ?xa h⇩2 (rev pvs@vs) ls⇩2 ?pc⇩2 ics frs sh⇩2"
using SCallNone⇩1.prems nmeth nclinit
by(cases "method P C' M'", cases "find_handler P ?xa h⇩2 frs sh⇩2", auto simp: handle_def)
finally show ?thesis using nclinit by (auto intro: exI[where x = ?pc⇩2])
qed
next
case (SCallNonStatic⇩1 es h⇩1 ls⇩1 sh⇩1 pvs h⇩2 ls⇩2 sh⇩2 C' M' Ts T body D)
show ?case
proof(cases "M' = clinit ∧ es = []")
case clinit: True then show ?thesis
using SCallNonStatic⇩1.hyps(3) SCallNonStatic⇩1.prems sees_method_fun by fastforce
next
case nclinit: False
let ?σ⇩1 = "(None,h⇩1,(vs, ls⇩1, C,M,pc,ics)#frs,sh⇩1)"
let ?pc⇩2 = "pc + length(compEs⇩2 es)"
let ?frs⇩2 = "(rev pvs @ vs, ls⇩2, C,M,?pc⇩2,ics)#frs"
let ?σ⇩2 = "(None,h⇩2,?frs⇩2,sh⇩2)"
let ?xa = "addr_of_sys_xcpt IncompatibleClassChangeError"
have "P⇩1 ⊢⇩1 ⟨es,(h⇩1, ls⇩1, sh⇩1)⟩ [⇒] ⟨map Val pvs,(h⇩2, ls⇩2, sh⇩2)⟩" by fact
hence [simp]: "length es = length pvs" by(auto dest:evals⇩1_preserves_elen)
obtain body' where method: "P ⊢ C' sees M', NonStatic : Ts→T = body' in D"
by (metis SCallNonStatic⇩1.hyps(3) P_def compP⇩2_def sees_method_compP)
have IH_es: "PROP ?Ps es h⇩1 ls⇩1 sh⇩1 (map Val pvs) h⇩2 ls⇩2 sh⇩2 C M pc ics pvs xa
(map Val pvs) vs frs I" by fact
have "P ⊢ ?σ⇩1 -jvm→ ?σ⇩2" using IH_es SCallNonStatic⇩1.prems nclinit by auto fastforce+
also have "P ⊢ … -jvm→ handle P C M ?xa h⇩2 (rev pvs@vs) ls⇩2 ?pc⇩2 ics frs sh⇩2"
using SCallNonStatic⇩1.prems method nclinit
by(cases "method P C' M'", cases "find_handler P ?xa h⇩2 frs sh⇩2")
(auto simp: handle_def; meson frames_of.cases)
finally show ?thesis using nclinit by (auto intro: exI[where x = ?pc⇩2])
qed
next
case (SCallInitThrow⇩1 es h⇩0 ls⇩0 sh⇩0 pvs h⇩1 ls⇩1 sh⇩1 C' M' Ts T body D a h⇩2 ls⇩2 sh⇩2)
show ?case
proof(cases "M' = clinit ∧ es = []")
case clinit: True then show ?thesis using SCallInitThrow⇩1 by simp
next
case nclinit: False
let ?σ⇩0 = "(None,h⇩0,(vs, ls⇩0, C,M,pc,ics)#frs,sh⇩0)"
let ?pc⇩1 = "pc + length(compEs⇩2 es)"
let ?frs⇩1 = "(rev pvs @ vs, ls⇩1, C,M,?pc⇩1,ics)#frs"
let ?σ⇩1 = "(None,h⇩1,?frs⇩1,sh⇩1)"
let ?frs⇩1' = "(rev pvs@vs,ls⇩1,C,M,?pc⇩1,Calling D [])#frs"
let ?σ⇩1' = "(None,h⇩1,?frs⇩1',sh⇩1)"
let ?frs⇩2 = "(rev pvs@vs,ls⇩1,C,M,?pc⇩1,Called [])#frs"
let ?σ⇩2 = "(None,h⇩2,?frs⇩2,sh⇩2)"
have ls: "ls⇩1 = ls⇩2" by(rule init⇩1_same_loc[OF SCallInitThrow⇩1.hyps(6)])
have method: "∃m'. P ⊢ C' sees M',Static:Ts→T = m' in D" using SCallInitThrow⇩1.hyps(3)
by (metis P_def compP⇩2_def sees_method_compP)
obtain a' where throw: "throw a = Throw a'" using eval⇩1_final[OF SCallInitThrow⇩1.hyps(6)] by clarsimp
have "Ex (WTrt2⇩1 P⇩1 E h⇩1 sh⇩1 (INIT D ([D],False) ← unit))"
using sees_method_is_class'[OF SCallInitThrow⇩1.hyps(3)] by auto
then obtain err' where pcs':
"Jcc_pieces P⇩1 E C M h⇩1 (rev pvs@vs) ls⇩1 ?pc⇩1 ics frs sh⇩1 I h⇩2 ls⇩2 sh⇩2 v xa (INIT D ([D],False) ← unit)
= (True, ?frs⇩1', (None,h⇩2,?frs⇩2,sh⇩2), err')"
using SCallInitThrow⇩1.prems(1) nclinit by auto
have IHI: "PROP ?P (INIT D ([D],False) ← unit) h⇩1 ls⇩1 sh⇩1 (throw a)
h⇩2 ls⇩2 sh⇩2 E C M ?pc⇩1 ics v a' (rev pvs@vs) frs I" by fact
have IH_es: "PROP ?Ps es h⇩0 ls⇩0 sh⇩0 (map Val pvs) h⇩1 ls⇩1 sh⇩1 C M pc ics pvs xa
(map Val pvs) vs frs I" by fact
have "P ⊢ ?σ⇩0 -jvm→ ?σ⇩1" using IH_es SCallInitThrow⇩1.prems nclinit by auto fastforce+
also have "P ⊢ … -jvm→ ?σ⇩1'"
proof(cases "sh⇩1 D")
case None then show ?thesis using SCallInitThrow⇩1.hyps(1,3-6) SCallInitThrow⇩1.prems method
by(cases ics) auto
next
case (Some a)
then obtain sfs i where "a = (sfs,i)" by(cases a)
then show ?thesis using SCallInitThrow⇩1.hyps(1,3-6) SCallInitThrow⇩1.prems method Some
by(cases ics; case_tac i, auto)
qed
also obtain vs' where "P ⊢ … -jvm→ handle P C M a' h⇩2 (vs'@rev pvs@vs) ls⇩1 ?pc⇩1 ics frs sh⇩2"
using IHI pcs' throw by auto
finally show ?thesis using nclinit throw ls
by(auto intro!: exI[where x="?pc⇩1"] exI[where x="vs'@rev pvs"])
qed
next
case (SCallInit⇩1 es h⇩0 ls⇩0 sh⇩0 pvs h⇩1 ls⇩1 sh⇩1 C' M' Ts T body D v' h⇩2 ls⇩2 sh⇩2 ls⇩2' e' h⇩3 ls⇩3 sh⇩3)
show ?case
proof(cases "M' = clinit ∧ es = []")
case clinit: True then show ?thesis using SCallInit⇩1 by simp
next
case nclinit: False
let ?σ⇩0 = "(None,h⇩0,(vs, ls⇩0, C,M,pc,ics)#frs,sh⇩0)"
let ?pc⇩1 = "pc + length(compEs⇩2 es)"
let ?frs⇩1 = "(rev pvs @ vs, ls⇩1, C,M,?pc⇩1,ics)#frs"
let ?σ⇩1 = "(None,h⇩1,?frs⇩1,sh⇩1)"
let ?frs⇩1' = "(rev pvs@vs,ls⇩1,C,M,?pc⇩1,Calling D [])#frs"
let ?σ⇩1' = "(None,h⇩1,?frs⇩1',sh⇩1)"
let ?frs⇩2 = "(rev pvs@vs,ls⇩1,C,M,?pc⇩1,Called [])#frs"
let ?σ⇩2 = "(None,h⇩2,?frs⇩2,sh⇩2)"
let ?frs⇩2' = "([], ls⇩2', D,M',0,No_ics) # ?frs⇩1"
let ?σ⇩2' = "(None, h⇩2, ?frs⇩2', sh⇩2)"
have nclinit': "M' ≠ clinit" by fact
have ics: "ics = No_ics" using SCallInit⇩1.hyps(5) SCallInit⇩1.prems by simp
have "P⇩1 ⊢⇩1 ⟨es,(h⇩0, ls⇩0, sh⇩0)⟩ [⇒] ⟨map Val pvs,(h⇩1, ls⇩1, sh⇩1)⟩" by fact
hence [simp]: "length es = length pvs" by(auto dest:evals⇩1_preserves_elen)
have invoke: "P,C,M,?pc⇩1 ▹ Invokestatic C' M' (length Ts)"
using SCallInit⇩1.hyps(8) SCallInit⇩1.prems nclinit by(auto simp: add.assoc)
have nsub: "¬ sub_RI body" by(rule sees_wf⇩1_nsub_RI[OF wf SCallInit⇩1.hyps(3)])
have ls: "ls⇩1 = ls⇩2" by(rule init⇩1_same_loc[OF SCallInit⇩1.hyps(6)])
obtain sfs i where sh⇩2: "sh⇩2 D = Some(sfs,i)"
using init⇩1_Val_PD[OF SCallInit⇩1.hyps(6)] by clarsimp
have method: "∃m'. P ⊢ C' sees M',Static:Ts→T = m' in D" using SCallInit⇩1.hyps(3)
by (metis P_def compP⇩2_def sees_method_compP)
have "Ex (WTrt2⇩1 P⇩1 E h⇩1 sh⇩1 (INIT D ([D],False) ← unit))"
using sees_method_is_class'[OF SCallInit⇩1.hyps(3)] by auto
then obtain err' where pcs':
"Jcc_pieces P⇩1 E C M h⇩1 (rev pvs@vs) ls⇩1 ?pc⇩1 ics frs sh⇩1 I h⇩2 ls⇩2 sh⇩2 v' xa (INIT D ([D],False) ← unit)
= (True, ?frs⇩1', (None,h⇩2,?frs⇩2,sh⇩2), err')"
using SCallInit⇩1.prems(1) nclinit by auto
have IHI: "PROP ?P (INIT D ([D],False) ← unit) h⇩1 ls⇩1 sh⇩1 (Val v')
h⇩2 ls⇩2 sh⇩2 E C M ?pc⇩1 ics v' xa (rev pvs@vs) frs I" by fact
have IH_es: "PROP ?Ps es h⇩0 ls⇩0 sh⇩0 (map Val pvs) h⇩1 ls⇩1 sh⇩1 C M pc ics pvs xa
(map Val pvs) vs frs I" by fact
have "P ⊢ ?σ⇩0 -jvm→ ?σ⇩1" using IH_es SCallInit⇩1.prems nclinit by auto fastforce+
also have "P ⊢ … -jvm→ ?σ⇩1'"
proof(cases "sh⇩1 D")
case None then show ?thesis using SCallInit⇩1.hyps(1,3-6,8-10) SCallInit⇩1.prems method
by(cases ics) auto
next
case (Some a)
then obtain sfs i where "a = (sfs,i)" by(cases a)
then show ?thesis using SCallInit⇩1.hyps(1,3-6,8-10) SCallInit⇩1.prems method Some
by(cases ics; case_tac i, auto)
qed
also have "P ⊢ … -jvm→ ?σ⇩2" using IHI pcs' by auto
also have "P ⊢ … -jvm→ ?σ⇩2'"
using jvm_Invokestatic_Called[OF assms(1) invoke _ SCallInit⇩1.hyps(3,8,9)] sh⇩2 ics by auto
finally have 1: "P ⊢ ?σ⇩0 -jvm→ ?σ⇩2'".
have "P⇩1 ⊢ C' sees M',Static: Ts→T = body in D" by fact
then have M'_in_D: "P⇩1 ⊢ D sees M',Static: Ts→T = body in D"
by(rule sees_method_idemp)
have M'_code: "compP⇩2 P⇩1,D,M',0 ⊳ compE⇩2 body @ [Return]" using beforeM M'_in_D by simp
have M'_xtab: "compP⇩2 P⇩1,D,M' ⊳ compxE⇩2 body 0 0/{..<size(compE⇩2 body)},0"
using M'_in_D by(rule beforexM)
have IH_body: "PROP ?P body h⇩2 ls⇩2' sh⇩2 e' h⇩3 ls⇩3 sh⇩3 (Class D # Ts) D M' 0 No_ics v xa [] ?frs⇩1
({..<size(compE⇩2 body)})" by fact
have cond: "Jcc_cond P⇩1 (Class D # Ts) D M' [] 0 No_ics {..<length (compE⇩2 body)} h⇩2 sh⇩2 body"
using nsub_RI_Jcc_pieces[OF assms(1) nsub] M'_code M'_xtab by clarsimp
show ?thesis (is "?Norm ∧ ?Err")
proof
show ?Norm (is "?val ⟶ ?trans")
proof
assume val: ?val
note 1
also have "P ⊢ ?σ⇩2' -jvm→ (None,h⇩3,([v],ls⇩3,D,M',size(compE⇩2 body),No_ics)#?frs⇩1,sh⇩3)"
using val IH_body SCallInit⇩1.prems M'_code cond nsub_RI_Jcc_pieces nsub by auto
also have "P ⊢ … -jvm→ (None, h⇩3, (v#vs, ls⇩2, C,M,?pc⇩1+1,ics)#frs,sh⇩3)"
using SCallInit⇩1.hyps(8) M'_code M'_in_D ls nclinit' by(cases T, auto)
finally show ?trans using nclinit by(auto simp:add.assoc)
qed
next
show ?Err (is "?throw ⟶ ?err")
proof
assume throw: ?throw
with IH_body obtain pc⇩2 vs' where
pc⇩2: "0 ≤ pc⇩2 ∧ pc⇩2 < size(compE⇩2 body) ∧
¬ caught P pc⇩2 h⇩3 xa (compxE⇩2 body 0 0)" and
2: "P ⊢ ?σ⇩2' -jvm→ handle P D M' xa h⇩3 vs' ls⇩3 pc⇩2 No_ics ?frs⇩1 sh⇩3"
using SCallInit⇩1.prems M'_code M'_xtab cond nsub_RI_Jcc_pieces nsub
by (auto simp del:split_paired_Ex)
have "handle P D M' xa h⇩3 vs' ls⇩3 pc⇩2 No_ics ?frs⇩1 sh⇩3 =
handle P C M xa h⇩3 (rev pvs @ vs) ls⇩2 ?pc⇩1 ics frs sh⇩3"
using pc⇩2 M'_in_D ls nclinit' by(auto simp add:handle_def)
then show "?err" using pc⇩2 jvm_trans[OF 1 2] nclinit
by(auto intro!:exI[where x="?pc⇩1"] exI[where x="rev pvs"])
qed
qed
qed
next
case (SCall⇩1 es h⇩1 ls⇩1 sh⇩1 pvs h⇩2 ls⇩2 sh⇩2 C' M' Ts T body D sfs ls⇩2' e' h⇩3 ls⇩3 sh⇩3)
show ?case
proof(cases "M' = clinit ∧ es = []")
case clinit: True
then have s1: "pvs = []" "h⇩1 = h⇩2" "ls⇩1 = ls⇩2" "sh⇩1 = sh⇩2"
using SCall⇩1.hyps(1) evals⇩1_cases(1) by blast+
then have ls⇩2': "ls⇩2' = replicate (max_vars body) undefined" using SCall⇩1.hyps(6) clinit by simp
let ?frs = "create_init_frame P C' # (vs, ls⇩1, C,M,pc,ics)#frs"
let ?σ⇩1 = "(None,h⇩1,?frs,sh⇩1)"
have method: "P⇩1 ⊢ C' sees clinit,Static: []→Void = body in C'"
using SCall⇩1.hyps(3) clinit s1(1) wf_sees_clinit[OF wf]
by (metis is_class_def option.collapse sees_method_fun sees_method_is_class)
then have M_code: "compP⇩2 P⇩1,C',clinit,0 ⊳ compE⇩2 body @ [Return]" by(rule beforeM)
have pcs: "Jcc_pieces P⇩1 E C M h⇩1 vs ls⇩1 pc ics frs sh⇩1 I h⇩3 ls⇩2 sh⇩3 v xa (C'∙⇩sclinit([]))
= (True, ?frs, (None, h⇩3, tl ?frs, sh⇩3(C'↦(fst(the(sh⇩3 C')),Done))),
P ⊢ (None, h⇩1, ?frs, sh⇩1) -jvm→
(case ics of
Called Cs ⇒ (None, h⇩3, (vs, ls⇩1, C, M, pc, Throwing Cs xa) # frs, sh⇩3(C' ↦ (fst (the (sh⇩3 C')), Error)))))"
using Jcc_pieces_clinit[OF assms(1),of E C M vs pc ics I h⇩1 sh⇩1 C' ls⇩1 frs h⇩3 ls⇩2 sh⇩3 v xa]
SCall⇩1.prems(1) clinit s1(1) by clarsimp
have IH_body: "PROP ?P body h⇩2 ls⇩2' sh⇩2 e' h⇩3 ls⇩3 sh⇩3 [] C' clinit 0 No_ics v xa [] (tl ?frs)
({..<size(compE⇩2 body)})" by fact
show ?thesis (is "?Norm ∧ ?Err")
proof
show ?Norm (is "?val ⟶ ?trans")
proof
assume val: ?val
then have "P ⊢ ?σ⇩1
-jvm→ (None, h⇩3, ([v], ls⇩3, C', clinit, size(compE⇩2 body), No_ics) # tl ?frs,sh⇩3)"
using IH_body Jcc_pieces_SCall_clinit_body[OF assms(1) wf pcs method] s1 ls⇩2' by clarsimp
also have "P ⊢ … -jvm→ (None, h⇩3, tl ?frs, sh⇩3(C'↦(fst(the(sh⇩3 C')),Done)))"
using jvm_Return_Init[OF M_code] by simp
finally show ?trans using pcs s1 clinit by simp
qed
next
show ?Err (is "?throw ⟶ ?err")
proof
assume throw: ?throw
with IH_body obtain pc⇩2 vs2 where
pc⇩2: "0 ≤ pc⇩2 ∧ pc⇩2 < size(compE⇩2 body) ∧
¬ caught P pc⇩2 h⇩3 xa (compxE⇩2 body 0 0)" and
2: "P ⊢ ?σ⇩1 -jvm→ handle P C' clinit xa h⇩3 vs2 ls⇩3 pc⇩2 No_ics (tl ?frs) sh⇩3"
using SCall⇩1.prems Jcc_pieces_SCall_clinit_body[OF assms(1) wf pcs method] s1 ls⇩2' by clarsimp
show ?err using SCall⇩1.prems(1) clinit
proof(cases ics)
case (Called Cs)
note 2
also have "handle P C' clinit xa h⇩3 vs2 ls⇩3 pc⇩2 No_ics (tl ?frs) sh⇩3
= (None, h⇩3, (vs, ls⇩1, C, M, pc, Throwing (C'#Cs) xa) # frs, sh⇩3)"
using Called pc⇩2 method by(simp add: handle_def)
also have "P ⊢ … -jvm→ (None, h⇩3, (vs, ls⇩1, C, M, pc, Throwing Cs xa) # frs,
sh⇩3(C' ↦ (fst (the (sh⇩3 C')), Error)))" using Called jvm_Throwing by simp
finally show ?thesis using pcs clinit Called by(clarsimp intro!: exI[where x="[]"])
qed(auto)
qed
qed
next
case nclinit: False
let ?σ⇩1 = "(None,h⇩1,(vs, ls⇩1, C,M,pc,ics)#frs,sh⇩1)"
let ?pc⇩2 = "pc + length(compEs⇩2 es)"
let ?frs⇩2 = "(rev pvs @ vs, ls⇩2, C,M,?pc⇩2,ics)#frs"
let ?σ⇩2 = "(None,h⇩2,?frs⇩2,sh⇩2)"
let ?frs⇩2' = "([], ls⇩2', D,M',0,No_ics) # ?frs⇩2"
let ?σ⇩2' = "(None, h⇩2, ?frs⇩2', sh⇩2)"
have nclinit': "M' ≠ clinit"
using wf_sees_clinit1[OF wf] visible_method_exists[OF SCall⇩1.hyps(3)]
sees_method_idemp[OF SCall⇩1.hyps(3)] nclinit SCall⇩1.hyps(5)
evals⇩1_preserves_elen[OF SCall⇩1.hyps(1)] by fastforce
have "P⇩1 ⊢⇩1 ⟨es,(h⇩1, ls⇩1, sh⇩1)⟩ [⇒] ⟨map Val pvs,(h⇩2, ls⇩2, sh⇩2)⟩" by fact
hence [simp]: "length es = length pvs" by(auto dest:evals⇩1_preserves_elen)
have invoke: "P,C,M,?pc⇩2 ▹ Invokestatic C' M' (length Ts)"
using SCall⇩1.hyps(5) SCall⇩1.prems nclinit by(auto simp: add.assoc)
have nsub: "¬ sub_RI body" by(rule sees_wf⇩1_nsub_RI[OF wf SCall⇩1.hyps(3)])
have IH_es: "PROP ?Ps es h⇩1 ls⇩1 sh⇩1 (map Val pvs) h⇩2 ls⇩2 sh⇩2 C M pc ics pvs xa
(map Val pvs) vs frs I" by fact
have "P ⊢ ?σ⇩1 -jvm→ ?σ⇩2" using IH_es SCall⇩1.prems nclinit by auto fastforce+
also have "P ⊢ … -jvm→ ?σ⇩2'" using jvm_Invokestatic[OF assms(1) invoke _ SCall⇩1.hyps(3,5,6)]
SCall⇩1.hyps(4) SCall⇩1.prems nclinit by auto
finally have 1: "P ⊢ ?σ⇩1 -jvm→ ?σ⇩2'".
have "P⇩1 ⊢ C' sees M',Static: Ts→T = body in D" by fact
then have M'_in_D: "P⇩1 ⊢ D sees M',Static: Ts→T = body in D"
by(rule sees_method_idemp)
have M'_code: "compP⇩2 P⇩1,D,M',0 ⊳ compE⇩2 body @ [Return]" using beforeM M'_in_D by simp
have M'_xtab: "compP⇩2 P⇩1,D,M' ⊳ compxE⇩2 body 0 0/{..<size(compE⇩2 body)},0"
using M'_in_D by(rule beforexM)
have IH_body: "PROP ?P body h⇩2 ls⇩2' sh⇩2 e' h⇩3 ls⇩3 sh⇩3 (Class D # Ts) D M' 0 No_ics v xa [] ?frs⇩2
({..<size(compE⇩2 body)})" by fact
have cond: "Jcc_cond P⇩1 (Class D # Ts) D M' [] 0 No_ics {..<length (compE⇩2 body)} h⇩2 sh⇩2 body"
using nsub_RI_Jcc_pieces[OF assms(1) nsub] M'_code M'_xtab by clarsimp
show ?thesis (is "?Norm ∧ ?Err")
proof
show ?Norm (is "?val ⟶ ?trans")
proof
assume val: ?val
note 1
also have "P ⊢ ?σ⇩2' -jvm→ (None,h⇩3,([v],ls⇩3,D,M',size(compE⇩2 body),No_ics)#?frs⇩2,sh⇩3)"
using val IH_body SCall⇩1.prems M'_code cond nsub_RI_Jcc_pieces nsub by auto
also have "P ⊢ … -jvm→ (None, h⇩3, (v#vs, ls⇩2, C,M,?pc⇩2+1,ics)#frs,sh⇩3)"
using SCall⇩1.hyps(5) M'_code M'_in_D nclinit' by(cases T, auto)
finally show ?trans using nclinit by(auto simp:add.assoc)
qed
next
show ?Err (is "?throw ⟶ ?err")
proof
assume throw: ?throw
with IH_body obtain pc⇩2 vs' where
pc⇩2: "0 ≤ pc⇩2 ∧ pc⇩2 < size(compE⇩2 body) ∧
¬ caught P pc⇩2 h⇩3 xa (compxE⇩2 body 0 0)" and
2: "P ⊢ ?σ⇩2' -jvm→ handle P D M' xa h⇩3 vs' ls⇩3 pc⇩2 No_ics ?frs⇩2 sh⇩3"
using SCall⇩1.prems M'_code M'_xtab cond nsub_RI_Jcc_pieces nsub
by (auto simp del:split_paired_Ex)
have "handle P D M' xa h⇩3 vs' ls⇩3 pc⇩2 No_ics ?frs⇩2 sh⇩3 =
handle P C M xa h⇩3 (rev pvs @ vs) ls⇩2 ?pc⇩2 ics frs sh⇩3"
using pc⇩2 M'_in_D nclinit' by(auto simp add:handle_def)
then show "?err" using pc⇩2 jvm_trans[OF 1 2] nclinit by(auto intro:exI[where x="?pc⇩2"])
qed
qed
qed
next
case Block⇩1 then show ?case using nsub_RI_Jcc_pieces by auto
next
case (Seq⇩1 e⇩1 h⇩0 ls⇩0 sh⇩0 w h⇩1 ls⇩1 sh⇩1 e⇩2 e⇩2' h⇩2 ls⇩2 sh⇩2)
let ?pc⇩1 = "pc + length(compE⇩2 e⇩1)"
let ?σ⇩0 = "(None,h⇩0,(vs,ls⇩0,C,M,pc,ics)#frs,sh⇩0)"
let ?σ⇩1 = "(None,h⇩1,(vs,ls⇩1,C,M,?pc⇩1+1,ics)#frs,sh⇩1)"
let ?I = "I - pcs (compxE⇩2 e⇩2 (Suc ?pc⇩1) (length vs))"
have Isub: "{pc..<pc + length (compE⇩2 e⇩1)} ⊆ ?I" using Seq⇩1.prems by clarsimp
have IH: "PROP ?P e⇩1 h⇩0 ls⇩0 sh⇩0 (Val w) h⇩1 ls⇩1 sh⇩1 E C M pc ics w xa vs frs ?I" by fact
have "P ⊢ ?σ⇩0 -jvm→ (None,h⇩1,(w#vs,ls⇩1,C,M,?pc⇩1,ics)#frs,sh⇩1)"
using Seq⇩1.prems nsub_RI_Jcc_pieces IH Isub by auto
also have "P ⊢ … -jvm→ ?σ⇩1" using Seq⇩1 by auto
finally have eval⇩1: "P ⊢ ?σ⇩0 -jvm→ ?σ⇩1".
let ?pc⇩2 = "?pc⇩1 + 1 + length(compE⇩2 e⇩2)"
let ?I' = "I - pcs(compxE⇩2 e⇩1 pc (size vs))"
have IH⇩2: "PROP ?P e⇩2 h⇩1 ls⇩1 sh⇩1 e⇩2' h⇩2 ls⇩2 sh⇩2 E C M (?pc⇩1+1) ics v xa vs frs
?I'" by fact
have Isub2: "{Suc (pc + length (compE⇩2 e⇩1))..<Suc (pc + length (compE⇩2 e⇩1) + length (compE⇩2 e⇩2))}
⊆ ?I'" using Seq⇩1.prems by clarsimp
show ?case (is "?Norm ∧ ?Err")
proof
show ?Norm (is "?val ⟶ ?trans")
proof
assume val: ?val
note eval⇩1
also have "P ⊢ ?σ⇩1 -jvm→ (None,h⇩2,(v#vs,ls⇩2,C,M,?pc⇩2,ics)#frs,sh⇩2)"
using val Seq⇩1.prems nsub_RI_Jcc_pieces IH⇩2 Isub2 by auto
finally show ?trans by(simp add:add.assoc)
qed
next
show ?Err (is "?throw ⟶ ?err")
proof
assume throw: ?throw
then obtain pc⇩2 vs' where
pc⇩2: "?pc⇩1+1 ≤ pc⇩2 ∧ pc⇩2 < ?pc⇩2 ∧
¬ caught P pc⇩2 h⇩2 xa (compxE⇩2 e⇩2 (?pc⇩1+1) (size vs))" and
eval⇩2: "P ⊢ ?σ⇩1 -jvm→ handle P C M xa h⇩2 (vs'@vs) ls⇩2 pc⇩2 ics frs sh⇩2"
using IH⇩2 Seq⇩1.prems nsub_RI_Jcc_pieces Isub2 by auto
show "?err" using pc⇩2 jvm_trans[OF eval⇩1 eval⇩2] by(auto intro: exI[where x=pc⇩2])
qed
qed
next
case (SeqThrow⇩1 e⇩0 h⇩0 ls⇩0 sh⇩0 e h⇩1 ls⇩1 sh⇩1 e⇩1)
let ?I = "I - pcs (compxE⇩2 e⇩1 (Suc (pc + length (compE⇩2 e⇩0))) (length vs))"
obtain a' where throw: "throw e = Throw a'" using eval⇩1_final[OF SeqThrow⇩1.hyps(1)] by clarsimp
have Isub: "{pc..<pc + length (compE⇩2 e⇩0)} ⊆ ?I" using SeqThrow⇩1.prems by clarsimp
have "PROP ?P e⇩0 h⇩0 ls⇩0 sh⇩0 (throw e) h⇩1 ls⇩1 sh⇩1 E C M pc ics v a' vs frs ?I" by fact
then show ?case using SeqThrow⇩1.prems throw nsub_RI_Jcc_pieces Isub by auto
next
case (CondT⇩1 e h⇩0 ls⇩0 sh⇩0 h⇩1 ls⇩1 sh⇩1 e⇩1 e' h⇩2 ls⇩2 sh⇩2 e⇩2)
let ?pc⇩1 = "pc + length(compE⇩2 e)"
let ?σ⇩0 = "(None,h⇩0,(vs,ls⇩0,C,M,pc,ics)#frs,sh⇩0)"
let ?σ⇩1 = "(None,h⇩1,(vs,ls⇩1,C,M,?pc⇩1+1,ics)#frs,sh⇩1)"
let ?d = "size vs"
let ?xt⇩1 = "compxE⇩2 e⇩1 (pc+size(compE⇩2 e)+1) ?d"
let ?xt⇩2 = "compxE⇩2 e⇩2 (pc+size(compE⇩2 e)+size(compE⇩2 e⇩1)+2) ?d"
let ?I = "I - (pcs ?xt⇩1 ∪ pcs ?xt⇩2)"
have Isub: "{pc..<pc + length (compE⇩2 e)} ⊆ ?I" using CondT⇩1.prems by clarsimp
have IH: "PROP ?P e h⇩0 ls⇩0 sh⇩0 true h⇩1 ls⇩1 sh⇩1 E C M pc ics (Bool True) xa vs frs ?I" by fact
have "P ⊢ ?σ⇩0 -jvm→ (None,h⇩1,(Bool(True)#vs,ls⇩1,C,M,?pc⇩1,ics)#frs,sh⇩1)"
using CondT⇩1.prems nsub_RI_Jcc_pieces IH Isub by(auto simp: Int_Un_distrib)
also have "P ⊢ … -jvm→ ?σ⇩1" using CondT⇩1 by auto
finally have eval⇩1: "P ⊢ ?σ⇩0 -jvm→ ?σ⇩1".
let ?pc⇩1' = "?pc⇩1 + 1 + length(compE⇩2 e⇩1)"
let ?pc⇩2' = "?pc⇩1' + 1 + length(compE⇩2 e⇩2)"
let ?I' = "I - pcs(compxE⇩2 e pc ?d) - pcs(compxE⇩2 e⇩2 (?pc⇩1'+1) ?d)"
have IH2: "PROP ?P e⇩1 h⇩1 ls⇩1 sh⇩1 e' h⇩2 ls⇩2 sh⇩2 E C M (?pc⇩1+1) ics v xa vs frs ?I'" by fact
show ?case (is "?Norm ∧ ?Err")
proof
show ?Norm (is "?val ⟶ ?trans")
proof
assume val: ?val
note eval⇩1
also have "P ⊢ ?σ⇩1 -jvm→ (None,h⇩2,(v#vs,ls⇩2,C,M,?pc⇩1',ics)#frs,sh⇩2)"
using val CondT⇩1.prems nsub_RI_Jcc_pieces IH2 by(fastforce simp:Int_Un_distrib)
also have "P ⊢ … -jvm→ (None,h⇩2,(v#vs,ls⇩2,C,M,?pc⇩2',ics)#frs,sh⇩2)"
using CondT⇩1 nsub_RI_Jcc_pieces by(auto simp:add.assoc)
finally show ?trans by(simp add:add.assoc)
qed
next
show ?Err (is "?throw ⟶ ?err")
proof
assume throw: ?throw
moreover
note IH2
ultimately obtain pc⇩2 vs' where
pc⇩2: "?pc⇩1+1 ≤ pc⇩2 ∧ pc⇩2 < ?pc⇩1' ∧
¬ caught P pc⇩2 h⇩2 xa (compxE⇩2 e⇩1 (?pc⇩1+1) (size vs))" and
eval⇩2: "P ⊢ ?σ⇩1 -jvm→ handle P C M xa h⇩2 (vs'@vs) ls⇩2 pc⇩2 ics frs sh⇩2"
using CondT⇩1.prems nsub_RI_Jcc_pieces by (fastforce simp:Int_Un_distrib)
show "?err" using pc⇩2 jvm_trans[OF eval⇩1 eval⇩2] by(auto intro: exI[where x=pc⇩2])
qed
qed
next
case (CondF⇩1 e h⇩0 ls⇩0 sh⇩0 h⇩1 ls⇩1 sh⇩1 e⇩2 e' h⇩2 ls⇩2 sh⇩2 e⇩1)
let ?pc⇩1 = "pc + length(compE⇩2 e)"
let ?pc⇩2 = "?pc⇩1 + 1 + length(compE⇩2 e⇩1)+ 1"
let ?pc⇩2' = "?pc⇩2 + length(compE⇩2 e⇩2)"
let ?σ⇩0 = "(None,h⇩0,(vs,ls⇩0,C,M,pc,ics)#frs,sh⇩0)"
let ?σ⇩1 = "(None,h⇩1,(vs,ls⇩1,C,M,?pc⇩2,ics)#frs,sh⇩1)"
let ?d = "size vs"
let ?xt⇩1 = "compxE⇩2 e⇩1 (pc+size(compE⇩2 e)+1) ?d"
let ?xt⇩2 = "compxE⇩2 e⇩2 (pc+size(compE⇩2 e)+size(compE⇩2 e⇩1)+2) ?d"
let ?I = "I - (pcs ?xt⇩1 ∪ pcs ?xt⇩2)"
let ?I' = "I - pcs(compxE⇩2 e pc ?d) - pcs(compxE⇩2 e⇩1 (?pc⇩1+1) ?d)"
have pcs: "pcs(compxE⇩2 e pc ?d) ∩ pcs(?xt⇩1 @ ?xt⇩2) = {}"
using CondF⇩1.prems by (simp add:Int_Un_distrib)
have Isub: "{pc..<pc + length (compE⇩2 e)} ⊆ ?I" using CondF⇩1.prems by clarsimp
have IH: "PROP ?P e h⇩0 ls⇩0 sh⇩0 false h⇩1 ls⇩1 sh⇩1 E C M pc ics (Bool False) xa vs frs ?I" by fact
have IH2: "PROP ?P e⇩2 h⇩1 ls⇩1 sh⇩1 e' h⇩2 ls⇩2 sh⇩2 E C M ?pc⇩2 ics v xa vs frs ?I'" by fact
have "P ⊢ ?σ⇩0 -jvm→ (None,h⇩1,(Bool(False)#vs,ls⇩1,C,M,?pc⇩1,ics)#frs,sh⇩1)"
using CondF⇩1.prems nsub_RI_Jcc_pieces IH Isub pcs by auto
also have "P ⊢ … -jvm→ ?σ⇩1" using CondF⇩1 by auto
finally have eval⇩1: "P ⊢ ?σ⇩0 -jvm→ ?σ⇩1".
show ?case (is "?Norm ∧ ?Err")
proof
show ?Norm (is "?val ⟶ ?trans")
proof
assume val: ?val
note eval⇩1
also have "P ⊢ ?σ⇩1 -jvm→ (None,h⇩2,(v#vs,ls⇩2,C,M,?pc⇩2',ics)#frs,sh⇩2)"
using val CondF⇩1.prems nsub_RI_Jcc_pieces IH2 by(fastforce simp:Int_Un_distrib)
finally show ?trans by(simp add:add.assoc)
qed
next
show ?Err (is "?throw ⟶ ?err")
proof
let ?I' = "I - pcs(compxE⇩2 e pc ?d) - pcs(compxE⇩2 e⇩1 (?pc⇩1+1) ?d)"
assume throw: ?throw
then obtain pc⇩2 vs' where
pc⇩2: "?pc⇩2 ≤ pc⇩2 ∧ pc⇩2 < ?pc⇩2' ∧
¬ caught P pc⇩2 h⇩2 xa (compxE⇩2 e⇩2 ?pc⇩2 ?d)" and
eval⇩2: "P ⊢ ?σ⇩1 -jvm→ handle P C M xa h⇩2 (vs'@vs) ls⇩2 pc⇩2 ics frs sh⇩2"
using CondF⇩1.prems nsub_RI_Jcc_pieces IH2 by(fastforce simp:Int_Un_distrib)
show "?err" using pc⇩2 jvm_trans[OF eval⇩1 eval⇩2] by(auto intro: exI[where x=pc⇩2])
qed
qed
next
case (CondThrow⇩1 e h⇩0 ls⇩0 sh⇩0 f h⇩1 ls⇩1 sh⇩1 e⇩1 e⇩2)
let ?d = "size vs"
let ?xt⇩1 = "compxE⇩2 e⇩1 (pc+size(compE⇩2 e)+1) ?d"
let ?xt⇩2 = "compxE⇩2 e⇩2 (pc+size(compE⇩2 e)+size(compE⇩2 e⇩1)+2) ?d"
let ?I = "I - (pcs ?xt⇩1 ∪ pcs ?xt⇩2)"
have Isub: "{pc..<pc + length (compE⇩2 e)} ⊆ ?I" using CondThrow⇩1.prems by clarsimp
have "pcs(compxE⇩2 e pc ?d) ∩ pcs(?xt⇩1 @ ?xt⇩2) = {}"
using CondThrow⇩1.prems by (simp add:Int_Un_distrib)
moreover have "PROP ?P e h⇩0 ls⇩0 sh⇩0 (throw f) h⇩1 ls⇩1 sh⇩1 E C M pc ics v xa vs frs ?I" by fact
ultimately show ?case using CondThrow⇩1.prems nsub_RI_Jcc_pieces Isub by auto
next
case (WhileF⇩1 e h⇩0 ls⇩0 sh⇩0 h⇩1 ls⇩1 sh⇩1 c)
let ?pc = "pc + length(compE⇩2 e)"
let ?pc' = "?pc + length(compE⇩2 c) + 3"
have Isub: "{pc..<pc + length (compE⇩2 e)} ⊆ I - pcs (compxE⇩2 c (Suc (pc + length (compE⇩2 e))) (length vs))"
using WhileF⇩1.prems by clarsimp
have Isub2: "{Suc (pc + length (compE⇩2 e))..<Suc (pc + length (compE⇩2 e) + length (compE⇩2 c))}
⊆ I - pcs (compxE⇩2 e pc (length vs))" using WhileF⇩1.prems by clarsimp
have IH: "PROP ?P e h⇩0 ls⇩0 sh⇩0 false h⇩1 ls⇩1 sh⇩1 E C M pc ics (Bool False) xa vs frs
(I - pcs (compxE⇩2 c (Suc (pc + length (compE⇩2 e))) (length vs)))" by fact
have "P ⊢ (None,h⇩0,(vs,ls⇩0,C,M,pc,ics)#frs,sh⇩0) -jvm→
(None,h⇩1,(Bool False#vs,ls⇩1,C,M,?pc,ics)#frs,sh⇩1)"
using WhileF⇩1.prems nsub_RI_Jcc_pieces IH Isub by auto
also have "P ⊢ … -jvm→ (None,h⇩1,(vs,ls⇩1,C,M,?pc',ics)#frs,sh⇩1)"
using WhileF⇩1 by (auto simp:add.assoc)
also have "P ⊢ … -jvm→ (None,h⇩1,(Unit#vs,ls⇩1,C,M,?pc'+1,ics)#frs,sh⇩1)"
using WhileF⇩1.prems by (auto simp:eval_nat_numeral)
finally show ?case by (simp add:add.assoc eval_nat_numeral)
next
case (WhileT⇩1 e h⇩0 ls⇩0 sh⇩0 h⇩1 ls⇩1 sh⇩1 c v⇩1 h⇩2 ls⇩2 sh⇩2 e⇩3 h⇩3 ls⇩3 sh⇩3)
let ?pc = "pc + length(compE⇩2 e)"
let ?pc' = "?pc + length(compE⇩2 c) + 1"
let ?σ⇩0 = "(None,h⇩0,(vs,ls⇩0,C,M,pc,ics)#frs,sh⇩0)"
let ?σ⇩2 = "(None,h⇩2,(vs,ls⇩2,C,M,pc,ics)#frs,sh⇩2)"
have Isub: "{pc..<pc + length (compE⇩2 e)} ⊆ I - pcs (compxE⇩2 c (Suc (pc + length (compE⇩2 e))) (length vs))"
using WhileT⇩1.prems by clarsimp
have Isub2: "{Suc (pc + length (compE⇩2 e))..<Suc (pc + length (compE⇩2 e) + length (compE⇩2 c))}
⊆ I - pcs (compxE⇩2 e pc (length vs))" using WhileT⇩1.prems by clarsimp
have IH: "PROP ?P e h⇩0 ls⇩0 sh⇩0 true h⇩1 ls⇩1 sh⇩1 E C M pc ics (Bool True) xa vs frs
(I - pcs (compxE⇩2 c (Suc (pc + length (compE⇩2 e))) (length vs)))" by fact
have IH2: "PROP ?P c h⇩1 ls⇩1 sh⇩1 (Val v⇩1) h⇩2 ls⇩2 sh⇩2 E C M (Suc ?pc) ics v⇩1 xa vs frs
(I - pcs (compxE⇩2 e pc (length vs)))" by fact
have "P ⊢ ?σ⇩0 -jvm→ (None,h⇩1,(Bool True#vs,ls⇩1,C,M,?pc,ics)#frs,sh⇩1)"
using WhileT⇩1.prems nsub_RI_Jcc_pieces IH Isub by auto
also have "P ⊢ … -jvm→ (None,h⇩1,(vs,ls⇩1,C,M,?pc+1,ics)#frs,sh⇩1)"
using WhileT⇩1.prems by auto
also have "P ⊢ … -jvm→ (None,h⇩2,(v⇩1#vs,ls⇩2,C,M,?pc',ics)#frs,sh⇩2)"
using WhileT⇩1.prems nsub_RI_Jcc_pieces IH2 Isub2 by auto
also have "P ⊢ … -jvm→ ?σ⇩2" using WhileT⇩1.prems by auto
finally have 1: "P ⊢ ?σ⇩0 -jvm→ ?σ⇩2".
show ?case (is "?Norm ∧ ?Err")
proof
show ?Norm (is "?val ⟶ ?trans")
proof
assume val: ?val
note 1
also have "P ⊢ ?σ⇩2 -jvm→ (None,h⇩3,(v#vs,ls⇩3,C,M,?pc'+3,ics)#frs,sh⇩3)"
using val WhileT⇩1 by (auto simp add:add.assoc eval_nat_numeral)
finally show ?trans by(simp add:add.assoc eval_nat_numeral)
qed
next
show ?Err (is "?throw ⟶ ?err")
proof
assume throw: ?throw
moreover
have "PROP ?P (while (e) c) h⇩2 ls⇩2 sh⇩2 e⇩3 h⇩3 ls⇩3 sh⇩3 E C M pc ics v xa vs frs I" by fact
ultimately obtain pc⇩2 vs' where
pc⇩2: "pc ≤ pc⇩2 ∧ pc⇩2 < ?pc'+3 ∧
¬ caught P pc⇩2 h⇩3 xa (compxE⇩2 (while (e) c) pc (size vs))" and
2: "P ⊢ ?σ⇩2 -jvm→ handle P C M xa h⇩3 (vs'@vs) ls⇩3 pc⇩2 ics frs sh⇩3"
using WhileT⇩1.prems by (auto simp:add.assoc eval_nat_numeral)
show "?err" using pc⇩2 jvm_trans[OF 1 2] by(auto intro: exI[where x=pc⇩2])
qed
qed
next
case (WhileCondThrow⇩1 e h ls sh e' h' ls' sh' c)
let ?I = "I - pcs (compxE⇩2 c (Suc (pc + length (compE⇩2 e))) (length vs))"
obtain a' where throw: "throw e' = Throw a'" using eval⇩1_final[OF WhileCondThrow⇩1.hyps(1)] by clarsimp
have Isub: "{pc..<pc + length (compE⇩2 e)} ⊆ ?I" using WhileCondThrow⇩1.prems by clarsimp
have "PROP ?P e h ls sh (throw e') h' ls' sh' E C M pc ics v a' vs frs ?I" by fact
then show ?case using WhileCondThrow⇩1.prems throw nsub_RI_Jcc_pieces Isub by auto
next
case (WhileBodyThrow⇩1 e h⇩0 ls⇩0 sh⇩0 h⇩1 ls⇩1 sh⇩1 c e' h⇩2 ls⇩2 sh⇩2)
let ?pc⇩1 = "pc + length(compE⇩2 e)"
let ?σ⇩0 = "(None,h⇩0,(vs,ls⇩0,C,M,pc,ics)#frs,sh⇩0)"
let ?σ⇩1 = "(None,h⇩1,(vs,ls⇩1,C,M,?pc⇩1+1,ics)#frs,sh⇩1)"
let ?I = "I - pcs (compxE⇩2 c (Suc (pc + length (compE⇩2 e))) (length vs))"
have Isub: "{pc..<pc + length (compE⇩2 e)} ⊆ ?I"
using WhileBodyThrow⇩1.prems by clarsimp
have IH: "PROP ?P e h⇩0 ls⇩0 sh⇩0 true h⇩1 ls⇩1 sh⇩1 E C M pc ics (Bool True) xa vs frs ?I" by fact
then have "P ⊢ ?σ⇩0 -jvm→ (None,h⇩1,(Bool(True)#vs,ls⇩1,C,M,?pc⇩1,ics)#frs,sh⇩1)"
using WhileBodyThrow⇩1.prems nsub_RI_Jcc_pieces Isub by auto
also have "P ⊢ … -jvm→ ?σ⇩1" using WhileBodyThrow⇩1 by auto
finally have eval⇩1: "P ⊢ ?σ⇩0 -jvm→ ?σ⇩1".
let ?pc⇩1' = "?pc⇩1 + 1 + length(compE⇩2 c)"
show ?case (is "?Norm ∧ ?Err")
proof
show ?Norm by simp
next
show ?Err (is "?throw ⟶ ?err")
proof
assume throw: ?throw
moreover
have "PROP ?P c h⇩1 ls⇩1 sh⇩1 (throw e') h⇩2 ls⇩2 sh⇩2 E C M (?pc⇩1+1) ics v xa vs frs
(I - pcs (compxE⇩2 e pc (size vs)))" by fact
ultimately obtain pc⇩2 vs' where
pc⇩2: "?pc⇩1+1 ≤ pc⇩2 ∧ pc⇩2 < ?pc⇩1' ∧
¬ caught P pc⇩2 h⇩2 xa (compxE⇩2 c (?pc⇩1+1) (size vs))" and
eval⇩2: "P ⊢ ?σ⇩1 -jvm→ handle P C M xa h⇩2 (vs'@vs) ls⇩2 pc⇩2 ics frs sh⇩2"
using WhileBodyThrow⇩1.prems nsub_RI_Jcc_pieces by (fastforce simp:Int_Un_distrib)
show "?err" using pc⇩2 jvm_trans[OF eval⇩1 eval⇩2] by(auto intro: exI[where x=pc⇩2])
qed
qed
next
case (Throw⇩1 e h⇩0 ls⇩0 sh⇩0 a h⇩1 ls⇩1 sh⇩1)
let ?pc = "pc + size(compE⇩2 e)"
have Isub: "{pc..<pc + length (compE⇩2 e)} ⊆ I" using Throw⇩1.prems by clarsimp
show ?case (is "?Norm ∧ ?Err")
proof
show ?Norm by simp
next
show ?Err (is "?throw ⟶ ?err")
proof
assume throw:?throw
have "PROP ?P e h⇩0 ls⇩0 sh⇩0 (addr a) h⇩1 ls⇩1 sh⇩1 E C M pc ics (Addr a) a vs frs I" by fact
then have "P ⊢ (None, h⇩0, (vs, ls⇩0, C, M, pc, ics) # frs, sh⇩0) -jvm→
(None, h⇩1, (Addr xa#vs, ls⇩1, C, M, ?pc, ics) # frs, sh⇩1)"
using Throw⇩1 nsub_RI_Jcc_pieces Isub throw by auto
also have "P ⊢ … -jvm→ handle P C M xa h⇩1 (Addr xa#vs) ls⇩1 ?pc ics frs sh⇩1"
using Throw⇩1.prems by(auto simp add:handle_def)
finally show "?err" by(auto intro!: exI[where x="?pc"] exI[where x="[Addr xa]"])
qed
qed
next
case (ThrowNull⇩1 e h⇩0 ls⇩0 sh⇩0 h⇩1 ls⇩1 sh⇩1)
let ?pc = "pc + size(compE⇩2 e)"
let ?xa = "addr_of_sys_xcpt NullPointer"
have Isub: "{pc..<pc + length (compE⇩2 e)} ⊆ I" using ThrowNull⇩1.prems by clarsimp
show ?case (is "?Norm ∧ ?Err")
proof
show ?Norm by simp
next
show ?Err (is "?throw ⟶ ?err")
proof
assume throw: ?throw
have "PROP ?P e h⇩0 ls⇩0 sh⇩0 null h⇩1 ls⇩1 sh⇩1 E C M pc ics Null xa vs frs I" by fact
then have "P ⊢ (None, h⇩0, (vs, ls⇩0, C, M, pc, ics) # frs, sh⇩0) -jvm→
(None, h⇩1, (Null#vs, ls⇩1, C, M, ?pc, ics) # frs, sh⇩1)"
using ThrowNull⇩1.prems nsub_RI_Jcc_pieces Isub by auto
also have "P ⊢ … -jvm→ handle P C M ?xa h⇩1 (Null#vs) ls⇩1 ?pc ics frs sh⇩1"
using ThrowNull⇩1.prems by(auto simp add:handle_def)
finally show "?err" using throw by(auto intro!: exI[where x="?pc"] exI[where x="[Null]"])
qed
qed
next
case (ThrowThrow⇩1 e h ls sh e' h' ls' sh')
obtain a' where throw: "throw e' = Throw a'" using eval⇩1_final[OF ThrowThrow⇩1.hyps(1)] by clarsimp
have Isub: "{pc..<pc + length (compE⇩2 e)} ⊆ I" using ThrowThrow⇩1.prems by clarsimp
have "PROP ?P e h ls sh (throw e') h' ls' sh' E C M pc ics v a' vs frs I" by fact
then show ?case using ThrowThrow⇩1.prems throw nsub_RI_Jcc_pieces Isub by auto
next
case (Try⇩1 e⇩1 h⇩0 ls⇩0 sh⇩0 v⇩1 h⇩1 ls⇩1 sh⇩1 Ci i e⇩2)
let ?pc⇩1 = "pc + length(compE⇩2 e⇩1)"
let ?pc⇩1' = "?pc⇩1 + 2 + length(compE⇩2 e⇩2)"
have "{pc..<pc+size(compE⇩2 (try e⇩1 catch(Ci i) e⇩2))} ⊆ I" using Try⇩1.prems by simp
also have "P,C,M ⊳ compxE⇩2 (try e⇩1 catch(Ci i) e⇩2) pc (size vs) / I,size vs"
using Try⇩1.prems by simp
ultimately have "P,C,M ⊳ compxE⇩2 e⇩1 pc (size vs) / {pc..<pc + length (compE⇩2 e⇩1)},size vs"
by(rule beforex_try)
hence "P ⊢ (None,h⇩0,(vs,ls⇩0,C,M,pc,ics)#frs,sh⇩0) -jvm→
(None,h⇩1,(v⇩1#vs,ls⇩1,C,M,?pc⇩1,ics)#frs,sh⇩1)"
using Try⇩1 nsub_RI_Jcc_pieces by auto blast
also have "P ⊢ … -jvm→ (None,h⇩1,(v⇩1#vs,ls⇩1,C,M,?pc⇩1',ics)#frs,sh⇩1)"
using Try⇩1.prems by auto
finally show ?case by (auto simp:add.assoc)
next
case (TryCatch⇩1 e⇩1 h⇩0 ls⇩0 sh⇩0 a h⇩1 ls⇩1 sh⇩1 D fs Ci i e⇩2 e⇩2' h⇩2 ls⇩2 sh⇩2)
let ?e = "try e⇩1 catch(Ci i) e⇩2"
let ?xt = "compxE⇩2 ?e pc (size vs)"
let ?σ⇩0 = "(None,h⇩0,(vs,ls⇩0,C,M,pc,ics)#frs,sh⇩0)"
let ?ls⇩1 = "ls⇩1[i := Addr a]"
let ?pc⇩1 = "pc + length(compE⇩2 e⇩1)"
let ?pc⇩1' = "?pc⇩1 + 2"
let ?σ⇩1 = "(None,h⇩1,(vs,?ls⇩1,C,M, ?pc⇩1',ics) # frs,sh⇩1)"
have I: "{pc..<pc + length (compE⇩2 (try e⇩1 catch(Ci i) e⇩2))} ⊆ I"
and beforex: "P,C,M ⊳ ?xt/I,size vs" using TryCatch⇩1.prems by simp+
have "P ⊢ ?σ⇩0 -jvm→ (None,h⇩1,((Addr a)#vs,ls⇩1,C,M, ?pc⇩1+1,ics) # frs,sh⇩1)"
proof -
have ics: "ics = No_ics" using TryCatch⇩1.prems by auto
have "PROP ?P e⇩1 h⇩0 ls⇩0 sh⇩0 (Throw a) h⇩1 ls⇩1 sh⇩1 E C M pc ics v a vs frs {pc..<pc + length (compE⇩2 e⇩1)}"
by fact
moreover have "P,C,M ⊳ compxE⇩2 e⇩1 pc (size vs)/{pc..<?pc⇩1},size vs"
using beforex I pcs_subset by(force elim!: beforex_appendD1)
ultimately have
"∃pc⇩1. pc ≤ pc⇩1 ∧ pc⇩1 < ?pc⇩1 ∧
¬ caught P pc⇩1 h⇩1 a (compxE⇩2 e⇩1 pc (size vs)) ∧
(∃vs'. P ⊢ ?σ⇩0 -jvm→ handle P C M a h⇩1 (vs'@vs) ls⇩1 pc⇩1 ics frs sh⇩1)"
using TryCatch⇩1.prems nsub_RI_Jcc_pieces by auto
then obtain pc⇩1 vs' where
pc⇩1_in_e⇩1: "pc ≤ pc⇩1" "pc⇩1 < ?pc⇩1" and
pc⇩1_not_caught: "¬ caught P pc⇩1 h⇩1 a (compxE⇩2 e⇩1 pc (size vs))" and
0: "P ⊢ ?σ⇩0 -jvm→ handle P C M a h⇩1 (vs'@vs) ls⇩1 pc⇩1 ics frs sh⇩1" by iprover
from beforex obtain xt⇩0 xt⇩1
where ex_tab: "ex_table_of P C M = xt⇩0 @ ?xt @ xt⇩1"
and disj: "pcs xt⇩0 ∩ I = {}" by(auto simp:beforex_def)
have hp: "h⇩1 a = Some (D, fs)" "P⇩1 ⊢ D ≼⇧* Ci" by fact+
have "pc⇩1 ∉ pcs xt⇩0" using pc⇩1_in_e⇩1 I disj by auto
with pc⇩1_in_e⇩1 pc⇩1_not_caught hp
show ?thesis using ex_tab 0 ics by(simp add:handle_def matches_ex_entry_def)
qed
also have "P ⊢ … -jvm→ ?σ⇩1" using TryCatch⇩1 by auto
finally have 1: "P ⊢ ?σ⇩0 -jvm→ ?σ⇩1" .
let ?pc⇩2 = "?pc⇩1' + length(compE⇩2 e⇩2)"
let ?I⇩2 = "{?pc⇩1' ..< ?pc⇩2}"
have "P,C,M ⊳ compxE⇩2 ?e pc (size vs) / I,size vs" by fact
hence beforex⇩2: "P,C,M ⊳ compxE⇩2 e⇩2 ?pc⇩1' (size vs) / ?I⇩2, size vs"
using I pcs_subset[of _ ?pc⇩1'] by(auto elim!:beforex_appendD2)
have IH⇩2: "PROP ?P e⇩2 h⇩1 ?ls⇩1 sh⇩1 e⇩2' h⇩2 ls⇩2 sh⇩2 E C M ?pc⇩1' ics v xa vs frs ?I⇩2" by fact
show ?case (is "?Norm ∧ ?Err")
proof
show ?Norm (is "?val ⟶ ?trans")
proof
assume val: ?val
note 1 also have "P ⊢ ?σ⇩1 -jvm→ (None,h⇩2,(v#vs,ls⇩2,C,M,?pc⇩2,ics)#frs,sh⇩2)"
using val beforex⇩2 IH⇩2 TryCatch⇩1.prems nsub_RI_Jcc_pieces by auto
finally show ?trans by(simp add:add.assoc)
qed
next
show ?Err (is "?throw ⟶ ?err")
proof
assume throw: ?throw
then obtain pc⇩2 vs' where
pc⇩2: "?pc⇩1+2 ≤ pc⇩2 ∧ pc⇩2 < ?pc⇩2 ∧
¬ caught P pc⇩2 h⇩2 xa (compxE⇩2 e⇩2 ?pc⇩1' (size vs))" and
2: "P ⊢ ?σ⇩1 -jvm→ handle P C M xa h⇩2 (vs'@vs) ls⇩2 pc⇩2 ics frs sh⇩2"
using IH⇩2 beforex⇩2 TryCatch⇩1.prems nsub_RI_Jcc_pieces by auto
show ?err using pc⇩2 jvm_trans[OF 1 2]
by (simp add:match_ex_entry) (auto intro: exI[where x=pc⇩2])
qed
qed
next
case (TryThrow⇩1 e⇩1 h⇩0 ls⇩0 sh⇩0 a h⇩1 ls⇩1 sh⇩1 D fs Ci i e⇩2)
let ?σ⇩0 = "(None,h⇩0,(vs,ls⇩0,C,M,pc,ics)#frs,sh⇩0)"
let ?pc⇩1 = "pc + length(compE⇩2 e⇩1)"
let ?e = "try e⇩1 catch(Ci i) e⇩2"
let ?xt = "compxE⇩2 ?e pc (size vs)"
have I: "{pc..<pc + length (compE⇩2 (try e⇩1 catch(Ci i) e⇩2))} ⊆ I"
and beforex: "P,C,M ⊳ ?xt/I,size vs" using TryThrow⇩1.prems by simp+
have "PROP ?P e⇩1 h⇩0 ls⇩0 sh⇩0 (Throw a) h⇩1 ls⇩1 sh⇩1 E C M pc ics v a vs frs
{pc..<pc + length (compE⇩2 e⇩1)}" by fact
moreover have "P,C,M ⊳ compxE⇩2 e⇩1 pc (size vs)/{pc..<?pc⇩1},size vs"
using beforex I pcs_subset by(force elim!: beforex_appendD1)
ultimately have
"∃pc⇩1. pc ≤ pc⇩1 ∧ pc⇩1 < ?pc⇩1 ∧
¬ caught P pc⇩1 h⇩1 a (compxE⇩2 e⇩1 pc (size vs)) ∧
(∃vs'. P ⊢ ?σ⇩0 -jvm→ handle P C M a h⇩1 (vs'@vs) ls⇩1 pc⇩1 ics frs sh⇩1)"
using TryThrow⇩1.prems nsub_RI_Jcc_pieces by auto
then obtain pc⇩1 vs' where
pc⇩1_in_e⇩1: "pc ≤ pc⇩1" "pc⇩1 < ?pc⇩1" and
pc⇩1_not_caught: "¬ caught P pc⇩1 h⇩1 a (compxE⇩2 e⇩1 pc (size vs))" and
0: "P ⊢ ?σ⇩0 -jvm→ handle P C M a h⇩1 (vs'@vs) ls⇩1 pc⇩1 ics frs sh⇩1" by iprover
show ?case (is "?N ∧ (?eq ⟶ ?err)")
proof
show ?N by simp
next
{ assume ?eq
with TryThrow⇩1 pc⇩1_in_e⇩1 pc⇩1_not_caught 0
have "?err" by (simp add:match_ex_entry) auto
}
thus "?eq ⟶ ?err" by iprover
qed
next
case Nil⇩1 thus ?case by simp
next
case (Cons⇩1 e h⇩0 ls⇩0 sh⇩0 v h⇩1 ls⇩1 sh⇩1 es fs h⇩2 ls⇩2 sh⇩2)
let ?pc⇩1 = "pc + length(compE⇩2 e)"
let ?σ⇩0 = "(None,h⇩0,(vs,ls⇩0,C,M,pc,ics)#frs,sh⇩0)"
let ?σ⇩1 = "(None,h⇩1,(v#vs,ls⇩1,C,M,?pc⇩1,ics)#frs,sh⇩1)"
have IH: "PROP ?P e h⇩0 ls⇩0 sh⇩0 (Val v) h⇩1 ls⇩1 sh⇩1 [] C M pc ics v xa vs frs
(I - pcs (compxEs⇩2 es ?pc⇩1 (Suc (length vs))))" by fact
then have 1: "P ⊢ ?σ⇩0 -jvm→ ?σ⇩1" using Jcc_pieces_Cons[OF _ Cons⇩1.prems(1-5)] by auto
let ?pc⇩2 = "?pc⇩1 + length(compEs⇩2 es)"
have IHs: "PROP ?Ps es h⇩1 ls⇩1 sh⇩1 fs h⇩2 ls⇩2 sh⇩2 C M ?pc⇩1 ics (tl ws) xa es' (v#vs) frs
(I - pcs (compxE⇩2 e pc (length vs)))" by fact
show ?case (is "?Norm ∧ ?Err")
proof
show ?Norm (is "?val ⟶ ?trans")
proof
assume val: ?val
note 1
also have "P ⊢ ?σ⇩1 -jvm→ (None,h⇩2,(rev(ws) @ vs,ls⇩2,C,M,?pc⇩2,ics)#frs,sh⇩2)"
using val IHs Cons⇩1.prems by fastforce
finally show ?trans by(simp add:add.assoc)
qed
next
show ?Err (is "?throw ⟶ (∃pc⇩2. ?H pc⇩2)")
proof
assume throw: ?throw
then obtain pc⇩2 vs' where
pc⇩2: "?pc⇩1 ≤ pc⇩2 ∧ pc⇩2 < ?pc⇩2 ∧
¬ caught P pc⇩2 h⇩2 xa (compxEs⇩2 es ?pc⇩1 (size vs + 1))" and
2: "P ⊢ ?σ⇩1 -jvm→ handle P C M xa h⇩2 (vs'@v#vs) ls⇩2 pc⇩2 ics frs sh⇩2"
using IHs Cons⇩1.prems by(fastforce simp:Cons_eq_append_conv neq_Nil_conv)
have "?H pc⇩2" using Cons⇩1.prems pc⇩2 jvm_trans[OF 1 2] by(auto intro!: exI[where x="vs'@[v]"])
thus "∃pc⇩2. ?H pc⇩2" by iprover
qed
qed
next
case (ConsThrow⇩1 e h⇩0 ls⇩0 sh⇩0 a h⇩1 ls⇩1 sh⇩1 es)
then show ?case using Jcc_pieces_Cons[OF _ ConsThrow⇩1.prems(1-5)]
by (fastforce simp:Cons_eq_append_conv)
next
case InitFinal⇩1 then show ?case using eval⇩1_final_same[OF InitFinal⇩1.hyps(1)] by clarsimp
next
case (InitNone⇩1 sh C⇩0 C' Cs e h l e' h' l' sh')
then obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h vs l pc ics frs sh I h' l' sh' v xa
(INIT C' (C⇩0 # Cs,False) ← e)
= (True, frs', (None, h', (vs, l, C, M, pc, Called []) # frs, sh'), err)"
using InitNone⇩1.prems(1) by clarsimp
let ?sh = "(sh(C⇩0 ↦ (sblank P⇩1 C⇩0, Prepared)))"
obtain ics: "ics_of(hd frs') = Calling C⇩0 Cs"
and frs⇩1: "frs' ≠ Nil" using pcs by clarsimp
then have 1: "P ⊢ (None,h,frs',sh) -jvm→ (None,h,frs',?sh)"
using InitNone⇩1 jvm_InitNone[where P = P] by(cases frs', simp+)
show ?case (is "(?e1 ⟶ ?jvm1) ∧ (?e2 ⟶ ?err)")
proof(rule conjI)
{ assume val: ?e1
note 1
also have "P ⊢ (None,h,frs',?sh) -jvm→ (None,h',(vs,l,C,M,pc,Called [])#frs,sh')"
using InitNone⇩1.hyps(3)[of E] Jcc_pieces_InitNone[OF assms(1) pcs] InitNone⇩1.prems val
by clarsimp
finally have ?jvm1 using pcs by simp
}
thus "?e1 ⟶ ?jvm1" by simp
next
{ assume throw: ?e2
note 1
also obtain vs' where "P ⊢ (None,h,frs',?sh)
-jvm→ handle P C M xa h' (vs'@vs) l pc ics frs sh'"
using InitNone⇩1.hyps(3)[of E] Jcc_pieces_InitNone[OF assms(1) pcs] throw
by clarsimp presburger
finally have ?err using pcs by auto
}
thus "?e2 ⟶ ?err" by simp
qed
next
case (InitDone⇩1 sh C⇩0 sfs C' Cs e h l e' h' l' sh')
then obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h vs l pc ics frs sh I h' l' sh' v xa
(INIT C' (C⇩0 # Cs,False) ← e)
= (True, frs', (None, h', (vs, l, C, M, pc, Called []) # frs, sh'), err)"
using InitDone⇩1.prems(1) by clarsimp
let ?frs' = "(calling_to_scalled (hd frs'))#(tl frs')"
have IH: "PROP ?P (INIT C' (Cs,True) ← e) h l sh e' h' l' sh' E C M pc ics v xa vs frs I"
by fact
obtain ics: "ics_of(hd frs') = Calling C⇩0 Cs"
and frs⇩1: "frs' ≠ Nil" using pcs by clarsimp
then have 1: "P ⊢ (None,h,frs',sh) -jvm→ (None,h,?frs',sh)"
using InitDone⇩1 jvm_InitDP[where P = P] by(cases frs', simp+)
show ?case (is "(?e1 ⟶ ?jvm1) ∧ (?e2 ⟶ ?err)")
proof(rule conjI)
{ assume val: ?e1
note 1
also have "P ⊢ (None,h,?frs',sh) -jvm→ (None,h',(vs,l,C,M,pc,Called [])#frs,sh')"
using IH Jcc_pieces_InitDP[OF assms(1) pcs] InitDone⇩1.prems val by clarsimp
finally have ?jvm1 using pcs by simp
}
thus "?e1 ⟶ ?jvm1" by simp
next
{ assume throw: ?e2
note 1
also obtain vs' where "P ⊢ (None,h,?frs',sh)
-jvm→ handle P C M xa h' (vs'@vs) l pc ics frs sh'"
using IH Jcc_pieces_InitDP[OF assms(1) pcs] InitDone⇩1.prems throw by clarsimp
finally have ?err using pcs by auto
}
thus "?e2 ⟶ ?err" by simp
qed
next
case (InitProcessing⇩1 sh C⇩0 sfs C' Cs e h l e' h' l' sh')
then obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h vs l pc ics frs sh I h' l' sh' v xa
(INIT C' (C⇩0 # Cs,False) ← e)
= (True, frs', (None, h', (vs, l, C, M, pc, Called []) # frs, sh'), err)"
using InitProcessing⇩1.prems(1) by clarsimp
let ?frs' = "(calling_to_scalled (hd frs'))#(tl frs')"
have IH: "PROP ?P (INIT C' (Cs,True) ← e) h l sh e' h' l' sh' E C M pc ics v xa vs frs I"
by fact
obtain ics: "ics_of(hd frs') = Calling C⇩0 Cs"
and frs⇩1: "frs' ≠ Nil" using pcs by clarsimp
then have 1: "P ⊢ (None,h,frs',sh) -jvm→ (None,h,?frs',sh)"
using InitProcessing⇩1 jvm_InitDP[where P = P] by(cases frs', simp+)
show ?case (is "(?e1 ⟶ ?jvm1) ∧ (?e2 ⟶ ?err)")
proof(rule conjI)
{ assume val: ?e1
note 1
also have "P ⊢ (None,h,?frs',sh) -jvm→ (None,h',(vs,l,C,M,pc,Called [])#frs,sh')"
using IH Jcc_pieces_InitDP[OF assms(1) pcs] InitProcessing⇩1.prems val by clarsimp
finally have ?jvm1 using pcs by simp
}
thus "?e1 ⟶ ?jvm1" by simp
next
{ assume throw: ?e2
note 1
also obtain vs' where "P ⊢ (None,h,?frs',sh)
-jvm→ handle P C M xa h' (vs'@vs) l pc ics frs sh'"
using IH Jcc_pieces_InitDP[OF assms(1) pcs] InitProcessing⇩1.prems throw by clarsimp
finally have ?err using pcs by auto
}
thus "?e2 ⟶ ?err" by simp
qed
next
case (InitError⇩1 sh C⇩0 sfs Cs e h l e' h' l' sh' C')
then obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h vs l pc ics frs sh I h' l' sh' v xa
(INIT C' (C⇩0 # Cs,False) ← e)
= (True, frs', (None, h', (vs, l, C, M, pc, Called []) # frs, sh'), err)"
using InitError⇩1.prems(1) by clarsimp
let ?e⇩0 = "THROW NoClassDefFoundError"
let ?frs' = "(calling_to_sthrowing (hd frs') (addr_of_sys_xcpt NoClassDefFoundError))#(tl frs')"
have IH: "PROP ?P (RI (C⇩0,?e⇩0) ; Cs ← e) h l sh e' h' l' sh' E C M pc ics v xa vs frs I" by fact
obtain ics: "ics_of(hd frs') = Calling C⇩0 Cs"
and frs⇩1: "frs' ≠ Nil"
and tl: "tl frs' = frs" using pcs by clarsimp
then have 1: "P ⊢ (None,h,frs',sh) -jvm→ (None,h,?frs',sh)"
proof(cases frs')
case (Cons a list)
obtain vs' l' C' M' pc' ics' where a: "a = (vs',l',C',M',pc',ics')" by(cases a)
then have "ics' = Calling C⇩0 Cs" using Cons ics by simp
then show ?thesis
using Cons a IH InitError⇩1.prems jvm_InitError[where P = P] InitError⇩1.hyps(1) by simp
qed(simp)
show ?case (is "(?e1 ⟶ ?jvm1) ∧ (?e2 ⟶ ?err)")
proof(rule conjI)
{ assume val: ?e1
then have False using val rinit⇩1_throw[OF InitError⇩1.hyps(2)] by blast
then have ?jvm1 using pcs by simp
}
thus "?e1 ⟶ ?jvm1" by simp
next
{ assume throw: ?e2
let ?frs = "(calling_to_throwing (hd frs') (addr_of_sys_xcpt NoClassDefFoundError))#(tl frs')"
have exec: "exec (P, (None,h,?frs,sh)) = Some (None,h,?frs',sh)"
using exec_ErrorThrowing[where sh=sh, OF InitError⇩1.hyps(1)] ics by(cases "hd frs'", simp)
obtain vs' where 2: "P ⊢ (None,h,?frs,sh) -jvm→ handle P C M xa h' (vs'@vs) l pc ics frs sh'"
using IH Jcc_pieces_InitError[OF assms(1) pcs InitError⇩1.hyps(1)] throw by clarsimp
have neq: "(None, h, ?frs, sh) ≠ handle P C M xa h' (vs' @ vs) l pc ics frs sh'"
using tl ics by(cases "hd frs'", simp add: handle_frs_tl_neq)
note 1
also have "P ⊢ (None,h,?frs',sh) -jvm→ handle P C M xa h' (vs'@vs) l pc ics frs sh'"
using exec_1_exec_all_conf[OF exec 2] neq by simp
finally have ?err using pcs by auto
}
thus "?e2 ⟶ ?err" by simp
qed
next
case (InitObject⇩1 sh C⇩0 sfs sh' C' Cs e h l e' h' l' sh'')
then obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h vs l pc ics frs sh I h' l'
(sh(C⇩0 ↦ (sfs, Processing))) v xa (INIT C' (C⇩0 # Cs,False) ← e)
= (True, frs', (None, h', (vs, l, C, M, pc, Called []) # frs, sh'), err)"
using InitObject⇩1.prems(1) by clarsimp
let ?frs' = "(calling_to_called (hd frs'))#(tl frs')"
have IH: "PROP ?P (INIT C' (C⇩0#Cs,True) ← e) h l sh' e' h' l' sh'' E C M pc ics v xa vs frs I"
by fact
obtain ics: "ics_of(hd frs') = Calling C⇩0 Cs"
and frs⇩1: "frs' ≠ Nil" using pcs by clarsimp
then have 1: "P ⊢ (None,h,frs',sh) -jvm→ (None,h,?frs',sh')"
proof(cases frs')
case (Cons a list)
obtain vs' l' C' M' pc' ics' where a: "a = (vs',l',C',M',pc',ics')" by(cases a)
then have "ics' = Calling C⇩0 Cs" using Cons ics by simp
then show ?thesis
using Cons Nil a IH InitObject⇩1 jvm_InitObj[where P = P] by simp
qed(simp)
show ?case (is "(?e1 ⟶ ?jvm1) ∧ (?e2 ⟶ ?err)")
proof(rule conjI)
{ assume val: ?e1
note 1
also have "P ⊢ (None,h,?frs',sh') -jvm→ (None,h',(vs,l,C,M,pc,Called [])#frs,sh'')"
using IH Jcc_pieces_InitObj[OF assms(1) pcs] InitObject⇩1 val by simp
finally have ?jvm1 using pcs by simp
}
thus "?e1 ⟶ ?jvm1" by simp
next
{ assume throw: ?e2
note 1
also obtain vs' where "P ⊢ (None,h,?frs',sh')
-jvm→ handle P C M xa h' (vs'@vs) l pc ics frs sh''"
using IH Jcc_pieces_InitObj[OF assms(1) pcs] InitObject⇩1 throw by clarsimp
finally have ?err using pcs by auto
}
thus "?e2 ⟶ ?err" by simp
qed
next
case (InitNonObject⇩1 sh C⇩0 sfs D a b sh' C' Cs e h l e' h' l' sh'')
then obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h vs l pc ics frs sh I h' l'
(sh(C⇩0 ↦ (sfs,Processing))) v xa (INIT C' (C⇩0 # Cs,False) ← e)
= (True, frs', (None, h', (vs, l, C, M, pc, Called []) # frs, sh'), err)"
using InitNonObject⇩1.prems(1) by clarsimp
let ?frs' = "(calling_to_calling (hd frs') D)#(tl frs')"
have cls1: "is_class P⇩1 D" using InitNonObject⇩1.hyps(2,3) class_wf wf wf_cdecl_supD by blast
have cls_aux: "distinct (C⇩0#Cs) ∧ supercls_lst P⇩1 (C⇩0#Cs)" using InitNonObject⇩1.prems(1) by auto
then have cls2: "D ∉ set (C⇩0 # Cs)"
proof -
have "distinct (D # C⇩0 # Cs)"
using InitNonObject⇩1.hyps(2,3) cls_aux wf wf_supercls_distinct_app by blast
then show "D ∉ set (C⇩0 # Cs)"
by (metis distinct.simps(2))
qed
have cls3: "∀C∈set (C⇩0 # Cs). P⇩1 ⊢ C ≼⇧* D" using InitNonObject⇩1.hyps(2,3) cls_aux
by (metis r_into_rtrancl rtrancl_into_rtrancl set_ConsD subcls1.subcls1I supercls_lst.simps(1))
have IH: "PROP ?P (INIT C' (D # C⇩0 # Cs,False) ← e) h l sh' e' h' l' sh'' E C M pc ics v xa vs frs I"
by fact
obtain r where cls: "class P C⇩0 = ⌊(D, r)⌋" using InitNonObject⇩1.hyps(3)
by (metis assms class_compP compP⇩2_def)
obtain ics: "ics_of(hd frs') = Calling C⇩0 Cs"
and frs⇩1: "frs' ≠ Nil" using pcs by clarsimp
then have 1: "P ⊢ (None,h,frs',sh) -jvm→ (None,h,?frs',sh')"
proof(cases frs')
case (Cons a list)
obtain vs' l' C' M' pc' ics' where a: "a = (vs',l',C',M',pc',ics')" by(cases a)
then have "ics' = Calling C⇩0 Cs" using Cons ics by simp
then show ?thesis
using Cons a IH InitNonObject⇩1 jvm_InitNonObj[OF _ _ cls] by simp
qed(simp)
show ?case (is "(?e1 ⟶ ?jvm1) ∧ (?e2 ⟶ ?err)")
proof(rule conjI)
{ assume val: ?e1
note 1
also have "P ⊢ (None,h,?frs',sh') -jvm→ (None,h',(vs,l,C,M,pc,Called [])#frs,sh'')"
using IH Jcc_pieces_InitNonObj[OF assms(1) cls1 cls2 cls3 pcs] InitNonObject⇩1 val by simp
finally have ?jvm1 using pcs by simp
}
thus "?e1 ⟶ ?jvm1" by simp
next
{ assume throw: ?e2
note 1
also obtain vs' where "P ⊢ (None,h,?frs',sh')
-jvm→ handle P C M xa h' (vs'@vs) l pc ics frs sh''"
using IH Jcc_pieces_InitNonObj[OF assms(1) cls1 cls2 cls3 pcs] InitNonObject⇩1 throw by clarsimp
finally have ?err using pcs by auto
}
thus "?e2 ⟶ ?err" by simp
qed
next
case (InitRInit⇩1 C⇩0 Cs e h l sh e' h' l' sh' C')
then obtain frs' err where pcs: "Jcc_pieces P⇩1 E C M h vs l pc ics frs sh I h' l' sh' v xa
(INIT C' (C⇩0 # Cs,True) ← e)
= (True, frs', (None, h', (vs, l, C, M, pc, Called []) # frs, sh'), err)"
using InitRInit⇩1.prems(1) by clarsimp
have IH: "PROP ?P (RI (C⇩0,C⇩0∙⇩sclinit([])) ; Cs ← e) h l sh e' h' l' sh' E C M pc ics v xa vs frs I"
by fact
show ?case (is "(?e1 ⟶ ?jvm1) ∧ (?e2 ⟶ ?err)")
proof(rule conjI)
{ assume val: ?e1
have "P ⊢ (None,h,frs',sh) -jvm→ (None,h',(vs,l,C,M,pc,Called [])#frs,sh')"
using IH Jcc_pieces_InitRInit[OF assms(1,2) pcs] InitRInit⇩1.prems val by simp
then have ?jvm1 using pcs by simp
}
thus "?e1 ⟶ ?jvm1" by simp
next
{ assume throw: ?e2
obtain vs' where "P ⊢ (None,h,frs',sh)
-jvm→ handle P C M xa h' (vs'@vs) l pc ics frs sh'"
using IH Jcc_pieces_InitRInit[OF assms(1,2) pcs] InitRInit⇩1 throw by clarsimp
then have ?err using pcs by auto
}
thus "?e2 ⟶ ?err" by simp
qed
next
case (RInit⇩1 e h l sh v1 h' l' sh' C⇩0 sfs i sh'' C' Cs e' e⇩1 h⇩1 l⇩1 sh⇩1)
let ?frs = "(vs,l,C,M,pc,Called (C⇩0#Cs)) # frs"
let ?frs' = "(vs,l,C,M,pc,Called Cs) # frs"
have clinit: "e = C⇩0∙⇩sclinit([])" using RInit⇩1
by (metis Jcc_cond.simps(2) eval⇩1_final_same exp.distinct(101) final_def)
then obtain err where pcs: "Jcc_pieces P⇩1 E C M h vs l pc ics frs sh I h⇩1 l⇩1 sh⇩1 v xa
(RI (C⇩0,C⇩0∙⇩sclinit([])) ; Cs ← e')
= (True, ?frs, (None, h⇩1, (vs, l, C, M, pc, Called []) # frs, sh⇩1), err)"
using RInit⇩1.prems(1) by simp
have shC: "∀C'∈set Cs. ∃sfs. sh C' = ⌊(sfs, Processing)⌋" using RInit⇩1.prems(1) clinit by clarsimp
then have shC'': "∀C'∈set Cs. ∃sfs. sh'' C' = ⌊(sfs, Processing)⌋"
using clinit⇩1_proc_pres[OF wf] RInit⇩1.hyps(1) clinit RInit⇩1.hyps(4) RInit⇩1.prems(1)
by (auto simp: fun_upd_apply)
have loc: "l = l'" using clinit⇩1_loc_pres RInit⇩1.hyps(1) clinit by simp
have IH: "PROP ?P e h l sh (Val v1) h' l' sh' E C M pc (Called Cs) v1 xa vs (tl ?frs') I" by fact
then have IH':
"PROP ?P (C⇩0∙⇩sclinit([])) h l sh (Val v1) h' l' sh' E C M pc (Called Cs) v1 xa vs (tl ?frs') I"
using clinit by simp
have IH2: "PROP ?P (INIT C' (Cs,True) ← e') h' l' sh'' e⇩1 h⇩1 l⇩1 sh⇩1 E C M
pc ics v xa vs frs I" by fact
have "P ⊢ (None,h,?frs,sh) -jvm→ (None,h,create_init_frame P C⇩0 # ?frs',sh)" by(rule jvm_Called)
also have "P ⊢ … -jvm→ (None,h',?frs',sh'')"
using IH' Jcc_pieces_RInit_clinit[OF assms(1-2) pcs,of h' l' sh'] RInit⇩1.hyps(3,4) by simp
finally have jvm1: "P ⊢ (None,h,?frs,sh) -jvm→ (None,h',?frs',sh'')" .
show ?case (is "(?e1 ⟶ ?jvm1) ∧ (?e2 ⟶ ?err)")
proof(rule conjI)
{ assume val: ?e1
note jvm1
also have "P ⊢ (None,h',?frs',sh'') -jvm→ (None,h⇩1,(vs,l,C,M,pc,Called [])#frs,sh⇩1)"
using IH2 Jcc_pieces_RInit_Init[OF assms(1-2) shC'' pcs,of h'] RInit⇩1.hyps(5) loc val by auto
finally have ?jvm1 using pcs clinit by simp
}
thus "?e1 ⟶ ?jvm1" by simp
next
{ assume throw: ?e2
note jvm1
also obtain vs' where "P ⊢ (None,h',?frs',sh'')
-jvm→ handle P C M xa h⇩1 (vs'@vs) l pc ics frs sh⇩1"
using IH2 Jcc_pieces_RInit_Init[OF assms(1-2) shC'' pcs,of h'] RInit⇩1.hyps(5) loc throw by auto
finally have ?err using pcs clinit by auto
}
thus "?e2 ⟶ ?err" by simp
qed
next
case (RInitInitFail⇩1 e h l sh a h' l' sh' C⇩0 sfs i sh'' D Cs e' e⇩1 h⇩1 l⇩1 sh⇩1)
let ?frs = "(vs,l,C,M,pc,Called (C⇩0#D#Cs)) # frs"
let ?frs' = "(vs,l,C,M,pc,Called (D#Cs)) # frs"
let "?frsT" = "λxa1. (vs,l,C,M,pc,Throwing (C⇩0#D#Cs) xa1) # frs"
let "?frsT'" = "λxa1. (vs,l,C,M,pc,Throwing (D#Cs) xa1) # frs"
obtain xa' where xa': "throw a = Throw xa'"
by (metis RInitInitFail⇩1.hyps(1) eval⇩1_final exp.distinct(101) final_def)
have e⇩1: "e⇩1 = Throw xa'" using xa' rinit⇩1_throw RInitInitFail⇩1.hyps(5) by simp
show ?case
proof(cases "e = C⇩0∙⇩sclinit([])")
case clinit: True
then obtain err where pcs: "Jcc_pieces P⇩1 E C M h vs l pc ics frs sh I h⇩1 l⇩1 sh⇩1 v xa'
(RI (C⇩0,C⇩0∙⇩sclinit([])) ; D # Cs ← e')
= (True, ?frs, (None, h⇩1, (vs, l, C, M, pc, Called []) # frs, sh⇩1), err)"
using RInitInitFail⇩1.prems(1) by simp
have loc: "l = l'" using clinit⇩1_loc_pres RInitInitFail⇩1.hyps(1) clinit by simp
have IH: "PROP ?P e h l sh (throw a) h' l' sh' E C M pc (Called (D#Cs)) v xa' vs frs I"
by fact
then have IH':
"PROP ?P (C⇩0∙⇩sclinit([])) h l sh (Throw xa') h' l' sh' E C M pc (Called (D#Cs)) v xa' vs
frs I" using clinit xa' by simp
have IH2: "PROP ?P (RI (D,throw a) ; Cs ← e') h' l' sh'' e⇩1 h⇩1 l⇩1 sh⇩1 E C M
pc ics v xa' vs frs I" by fact
have "P ⊢ (None,h,?frs,sh) -jvm→ (None,h,create_init_frame P C⇩0 # ?frs',sh)" by(rule jvm_Called)
also have "P ⊢ … -jvm→ (None,h',(vs, l, C, M, pc, Throwing (D#Cs) xa') # frs,sh'')"
using IH' Jcc_pieces_RInit_clinit[OF assms(1-2) pcs,of h' l' sh'] RInitInitFail⇩1.hyps(3,4)
by simp
also obtain vs'' where "P ⊢ … -jvm→ handle P C M xa' h⇩1 (vs''@vs) l pc ics frs sh⇩1"
using IH2 pcs Jcc_pieces_RInit_RInit[OF assms(1) pcs] RInitInitFail⇩1.hyps(3,4)
xa' loc e⇩1 xa' by clarsimp
finally show ?thesis using pcs e⇩1 clinit by auto
next
case throw: False
then have eT: "e = Throw xa'" "h = h'" "l = l'" "sh = sh'" using xa' RInitInitFail⇩1.prems(1)
eval⇩1_final_same[OF RInitInitFail⇩1.hyps(1)] by clarsimp+
obtain a' where "class P⇩1 C⇩0 = ⌊a'⌋" using RInitInitFail⇩1.prems by(auto simp: is_class_def)
then obtain stk' loc' M' pc' ics' where "create_init_frame P C⇩0 = (stk',loc',C⇩0,M',pc',ics')"
using create_init_frame_wf_eq[OF wf] by(cases "create_init_frame P C⇩0", simp)
then obtain rhs err where pcs: "Jcc_pieces P⇩1 E C M h vs l pc ics frs sh I h' l' sh'' v xa'
(RI (C⇩0,e) ; D#Cs ← e') = (True, ?frsT xa', rhs, err)"
using RInitInitFail⇩1.prems(1) eT by clarsimp
have IH2: "PROP ?P (RI (D,throw a) ; Cs ← e') h' l' sh'' e⇩1 h⇩1 l⇩1 sh⇩1 E C M
pc ics v xa' vs frs I" by fact
have "P ⊢ (None,h,?frsT xa',sh') -jvm→ (None,h,?frsT' xa',sh'(C⇩0 ↦ (fst (the (sh' C⇩0)), Error)))"
by(rule jvm_Throwing)
also obtain vs' where "P ⊢ ... -jvm→ handle P C M xa' h⇩1 (vs'@vs) l pc ics frs sh⇩1"
using IH2 Jcc_pieces_RInit_RInit[OF assms(1) pcs] RInitInitFail⇩1.hyps(3,4)
eT e⇩1 xa' by clarsimp
finally show ?thesis using pcs e⇩1 throw eT by auto
qed
next
case (RInitFailFinal⇩1 e h l sh a h' l' sh' C⇩0 sfs i sh'' e'')
let ?frs = "(vs,l,C,M,pc,Called [C⇩0]) # frs"
let ?frs' = "(vs,l,C,M,pc,Called []) # frs"
let "?frsT" = "λxa1. (vs,l,C,M,pc,Throwing [C⇩0] xa1) # frs"
let "?frsT'" = "λxa1. (vs,l,C,M,pc,Throwing [] xa1) # frs"
obtain xa' where xa': "throw a = Throw xa'"
by (metis RInitFailFinal⇩1.hyps(1) eval⇩1_final exp.distinct(101) final_def)
show ?case
proof(cases "e = C⇩0∙⇩sclinit([])")
case clinit: True
then obtain err where pcs: "Jcc_pieces P⇩1 E C M h vs l pc ics frs sh I h' l' sh'' v xa'
(RI (C⇩0,C⇩0∙⇩sclinit([])) ; [] ← unit) = (True, ?frs, (None, h', ?frs', sh''), err)"
using RInitFailFinal⇩1.prems(1) by clarsimp
have IH: "PROP ?P e h l sh (throw a) h' l' sh' E C M pc (Called []) v xa' vs frs I" by fact
then have IH':
"PROP ?P (C⇩0∙⇩sclinit([])) h l sh (throw a) h' l' sh' E C M pc (Called []) v xa' vs frs I"
using clinit by simp
have "P ⊢ (None,h,?frs,sh) -jvm→ (None,h,create_init_frame P C⇩0 # ?frs',sh)"
by(rule jvm_Called)
also have "P ⊢ … -jvm→ (None,h',?frsT' xa',sh'')"
using IH' Jcc_pieces_RInit_clinit[OF assms(1-2) pcs,of h' l' sh'] xa'
RInitFailFinal⇩1.hyps(3,4) by simp
also have
"P ⊢ … -jvm→ handle (compP compMb⇩2 P⇩1) C M xa' h' vs l pc No_ics frs sh''"
using RInitFailFinal⇩1.hyps(3,4) jvm_RInit_throw[where h=h' and sh=sh''] by simp
finally show ?thesis using xa' pcs clinit by(clarsimp intro!: exI[where x="[]"])
next
case throw: False
then have eT: "e = Throw xa'" "h = h'" "sh = sh'" using xa' RInitFailFinal⇩1.prems(1)
eval⇩1_final_same[OF RInitFailFinal⇩1.hyps(1)] by clarsimp+
obtain a where "class P⇩1 C⇩0 = ⌊a⌋" using RInitFailFinal⇩1.prems by(auto simp: is_class_def)
then obtain stk' loc' M' pc' ics' where "create_init_frame P C⇩0 = (stk',loc',C⇩0,M',pc',ics')"
using create_init_frame_wf_eq[OF wf] by(cases "create_init_frame P C⇩0", simp)
then obtain rhs err where pcs: "Jcc_pieces P⇩1 E C M h vs l pc ics frs sh I h' l' sh'' v xa'
(RI (C⇩0,e) ; [] ← unit) = (True, ?frsT xa', rhs, err)"
using RInitFailFinal⇩1.prems(1) eT by clarsimp
have "P ⊢ (None,h,?frsT xa',sh) -jvm→ (None,h,?frsT' xa',sh(C⇩0 ↦ (fst (the (sh C⇩0)), Error)))"
by(rule jvm_Throwing)
also have "P ⊢ … -jvm→ handle P C M xa' h' vs l pc No_ics frs sh''"
using RInitFailFinal⇩1.hyps(3,4) jvm_RInit_throw[where h=h and sh=sh''] eT by simp
finally show ?thesis using pcs xa' by(clarsimp intro!: exI[where x="[]"])
qed
qed
lemma atLeast0AtMost[simp]: "{0::nat..n} = {..n}"
by auto
lemma atLeast0LessThan[simp]: "{0::nat..<n} = {..<n}"
by auto
fun exception :: "'a exp ⇒ addr option" where
"exception (Throw a) = Some a"
| "exception e = None"
lemma comp⇩2_correct:
assumes wf: "wf_J⇩1_prog P⇩1"
and "method": "P⇩1 ⊢ C sees M,b:Ts→T = body in C"
and eval: "P⇩1 ⊢⇩1 ⟨body,(h,ls,sh)⟩ ⇒ ⟨e',(h',ls',sh')⟩"
and nclinit: "M ≠ clinit"
shows "compP⇩2 P⇩1 ⊢ (None,h,[([],ls,C,M,0,No_ics)],sh) -jvm→ (exception e',h',[],sh')"
(is "_ ⊢ ?σ⇩0 -jvm→ ?σ⇩1")
proof -
let ?P = "compP⇩2 P⇩1"
let ?E = "case b of Static ⇒ Ts | NonStatic ⇒ Class C#Ts"
have nsub: "¬sub_RI body" using sees_wf⇩1_nsub_RI[OF wf method] by simp
have code: "?P,C,M,0 ⊳ compE⇩2 body" using beforeM[OF "method"] by auto
have xtab: "?P,C,M ⊳ compxE⇩2 body 0 (size[])/{..<size(compE⇩2 body)},size[]"
using beforexM[OF "method"] by auto
have cond: "Jcc_cond P⇩1 ?E C M [] 0 No_ics {..<size(compE⇩2 body)} h sh body"
using nsub_RI_Jcc_pieces nsub code xtab by auto
{ fix v assume [simp]: "e' = Val v"
have "?P ⊢ ?σ⇩0 -jvm→ (None,h',[([v],ls',C,M,size(compE⇩2 body),No_ics)],sh')"
using Jcc[OF wf eval cond] nsub_RI_Jcc_pieces[OF _ nsub] by auto
also have "?P ⊢ … -jvm→ ?σ⇩1" using beforeM[OF "method"] nclinit by auto
finally have ?thesis .
}
moreover
{ fix a assume [simp]: "e' = Throw a"
obtain pc vs' where pc: "0 ≤ pc ∧ pc < size(compE⇩2 body) ∧
¬ caught ?P pc h' a (compxE⇩2 body 0 0)"
and 1: "?P ⊢ ?σ⇩0 -jvm→ handle ?P C M a h' vs' ls' pc No_ics [] sh'"
using Jcc[OF wf eval cond] nsub_RI_Jcc_pieces[OF _ nsub] by auto meson
from pc have "handle ?P C M a h' vs' ls' pc No_ics [] sh' = ?σ⇩1" using xtab "method" nclinit
by(auto simp:handle_def compMb⇩2_def)
with 1 have ?thesis by simp
}
ultimately show ?thesis using eval⇩1_final[OF eval] by(auto simp:final_def)
qed
end
Theory Compiler
section ‹ Combining Stages 1 and 2 ›
theory Compiler
imports Correctness1 Correctness2
begin
definition J2JVM :: "J_prog ⇒ jvm_prog"
where
"J2JVM ≡ compP⇩2 ∘ compP⇩1"
theorem comp_correct_NonStatic:
assumes wf: "wf_J_prog P"
and "method": "P ⊢ C sees M,NonStatic:Ts→T = (pns,body) in C"
and eval: "P ⊢ ⟨body,(h,[this#pns [↦] vs],sh)⟩ ⇒ ⟨e',(h',l',sh')⟩"
and sizes: "size vs = size pns + 1" "size rest = max_vars body"
shows "J2JVM P ⊢ (None,h,[([],vs@rest,C,M,0,No_ics)],sh) -jvm→ (exception e',h',[],sh')"
proof -
let ?P⇩1 = "compP⇩1 P"
have nclinit: "M ≠ clinit" using wf_sees_clinit1[OF wf] visible_method_exists[OF "method"]
sees_method_idemp[OF "method"] by fastforce
have wf⇩1: "wf_J⇩1_prog ?P⇩1" by(rule compP⇩1_pres_wf[OF wf])
have fv: "fv body ⊆ set (this#pns)"
using wf_prog_wwf_prog[OF wf] "method" by(auto dest!:sees_wf_mdecl simp:wf_mdecl_def)
have init: "[this#pns [↦] vs] ⊆⇩m [this#pns [↦] vs@rest]"
using sizes by simp
have "?P⇩1 ⊢ C sees M,NonStatic: Ts→T = (compE⇩1 (this#pns) body) in C"
using sees_method_compP[OF "method", of "λb (pns,e). compE⇩1 (case b of NonStatic ⇒ this#pns | Static ⇒ pns) e"]
by(simp)
moreover obtain ls' where
"?P⇩1 ⊢⇩1 ⟨compE⇩1 (this#pns) body, (h, vs@rest, sh)⟩ ⇒ ⟨fin⇩1 e', (h',ls', sh')⟩"
using eval⇩1_eval[OF wf_prog_wwf_prog[OF wf] eval fv init] sizes by auto
ultimately show ?thesis using comp⇩2_correct[OF wf⇩1] eval_final[OF eval] nclinit
by(fastforce simp add:J2JVM_def final_def)
qed
theorem comp_correct_Static:
assumes wf: "wf_J_prog P"
and "method": "P ⊢ C sees M,Static:Ts→T = (pns,body) in C"
and eval: "P ⊢ ⟨body,(h,[pns [↦] vs],sh)⟩ ⇒ ⟨e',(h',l',sh')⟩"
and sizes: "size vs = size pns" "size rest = max_vars body"
and nclinit: "M ≠ clinit"
shows "J2JVM P ⊢ (None,h,[([],vs@rest,C,M,0,No_ics)],sh) -jvm→ (exception e',h',[],sh')"
proof -
let ?P⇩1 = "compP⇩1 P"
have wf⇩1: "wf_J⇩1_prog ?P⇩1" by(rule compP⇩1_pres_wf[OF wf])
have fv: "fv body ⊆ set pns"
using wf_prog_wwf_prog[OF wf] "method" by(auto dest!:sees_wf_mdecl simp:wf_mdecl_def)
have init: "[pns [↦] vs] ⊆⇩m [pns [↦] vs@rest]"
using sizes by simp
have "?P⇩1 ⊢ C sees M,Static: Ts→T = (compE⇩1 pns body) in C"
using sees_method_compP[OF "method", of "λb (pns,e). compE⇩1 (case b of NonStatic ⇒ this#pns | Static ⇒ pns) e"]
by(simp)
moreover obtain ls' where
"?P⇩1 ⊢⇩1 ⟨compE⇩1 pns body, (h, vs@rest, sh)⟩ ⇒ ⟨fin⇩1 e', (h',ls', sh')⟩"
using eval⇩1_eval[OF wf_prog_wwf_prog[OF wf] eval fv init] sizes by auto
ultimately show ?thesis using comp⇩2_correct[OF wf⇩1] eval_final[OF eval] nclinit
by(fastforce simp add:J2JVM_def final_def)
qed
end
Theory TypeComp
section ‹ Preservation of Well-Typedness ›
theory TypeComp
imports Compiler "../BV/BVSpec"
begin
declare nth_append[simp]
lemma max_stack1: "P,E ⊢⇩1 e :: T ⟹ 1 ≤ max_stack e"
using max_stack1'[OF WT⇩1_nsub_RI] by simp
locale TC0 =
fixes P :: "J⇩1_prog" and mxl :: nat
begin
definition "ty E e = (THE T. P,E ⊢⇩1 e :: T)"
definition "ty⇩l E A' = map (λi. if i ∈ A' ∧ i < size E then OK(E!i) else Err) [0..<mxl]"
definition "ty⇩i' ST E A = (case A of None ⇒ None | ⌊A'⌋ ⇒ Some(ST, ty⇩l E A'))"
definition "after E A ST e = ty⇩i' (ty E e # ST) E (A ⊔ 𝒜 e)"
end
lemma (in TC0) ty_def2 [simp]: "P,E ⊢⇩1 e :: T ⟹ ty E e = T"
apply (unfold ty_def)
apply(blast intro: the_equality WT⇩1_unique)
done
lemma (in TC0) [simp]: "ty⇩i' ST E None = None"
by (simp add: ty⇩i'_def)
lemma (in TC0) ty⇩l_app_diff[simp]:
"ty⇩l (E@[T]) (A - {size E}) = ty⇩l E A"
by(auto simp add:ty⇩l_def hyperset_defs)
lemma (in TC0) ty⇩i'_app_diff[simp]:
"ty⇩i' ST (E @ [T]) (A ⊖ size E) = ty⇩i' ST E A"
by(auto simp add:ty⇩i'_def hyperset_defs)
lemma (in TC0) ty⇩l_antimono:
"A ⊆ A' ⟹ P ⊢ ty⇩l E A' [≤⇩⊤] ty⇩l E A"
by(auto simp:ty⇩l_def list_all2_conv_all_nth)
lemma (in TC0) ty⇩i'_antimono:
"A ⊆ A' ⟹ P ⊢ ty⇩i' ST E ⌊A'⌋ ≤' ty⇩i' ST E ⌊A⌋"
by(auto simp:ty⇩i'_def ty⇩l_def list_all2_conv_all_nth)
lemma (in TC0) ty⇩l_env_antimono:
"P ⊢ ty⇩l (E@[T]) A [≤⇩⊤] ty⇩l E A"
by(auto simp:ty⇩l_def list_all2_conv_all_nth)
lemma (in TC0) ty⇩i'_env_antimono:
"P ⊢ ty⇩i' ST (E@[T]) A ≤' ty⇩i' ST E A"
by(auto simp:ty⇩i'_def ty⇩l_def list_all2_conv_all_nth)
lemma (in TC0) ty⇩i'_incr:
"P ⊢ ty⇩i' ST (E @ [T]) ⌊insert (size E) A⌋ ≤' ty⇩i' ST E ⌊A⌋"
by(auto simp:ty⇩i'_def ty⇩l_def list_all2_conv_all_nth)
lemma (in TC0) ty⇩l_incr:
"P ⊢ ty⇩l (E @ [T]) (insert (size E) A) [≤⇩⊤] ty⇩l E A"
by(auto simp: hyperset_defs ty⇩l_def list_all2_conv_all_nth)
lemma (in TC0) ty⇩l_in_types:
"set E ⊆ types P ⟹ ty⇩l E A ∈ list mxl (err (types P))"
by(auto simp add:ty⇩l_def intro!:listI dest!: nth_mem)
locale TC1 = TC0
begin
primrec compT :: "ty list ⇒ nat hyperset ⇒ ty list ⇒ expr⇩1 ⇒ ty⇩i' list" and
compTs :: "ty list ⇒ nat hyperset ⇒ ty list ⇒ expr⇩1 list ⇒ ty⇩i' list" where
"compT E A ST (new C) = []"
| "compT E A ST (Cast C e) =
compT E A ST e @ [after E A ST e]"
| "compT E A ST (Val v) = []"
| "compT E A ST (e⇩1 «bop» e⇩2) =
(let ST⇩1 = ty E e⇩1#ST; A⇩1 = A ⊔ 𝒜 e⇩1 in
compT E A ST e⇩1 @ [after E A ST e⇩1] @
compT E A⇩1 ST⇩1 e⇩2 @ [after E A⇩1 ST⇩1 e⇩2])"
| "compT E A ST (Var i) = []"
| "compT E A ST (i := e) = compT E A ST e @
[after E A ST e, ty⇩i' ST E (A ⊔ 𝒜 e ⊔ ⌊{i}⌋)]"
| "compT E A ST (e∙F{D}) =
compT E A ST e @ [after E A ST e]"
| "compT E A ST (C∙⇩sF{D}) = []"
| "compT E A ST (e⇩1∙F{D} := e⇩2) =
(let ST⇩1 = ty E e⇩1#ST; A⇩1 = A ⊔ 𝒜 e⇩1; A⇩2 = A⇩1 ⊔ 𝒜 e⇩2 in
compT E A ST e⇩1 @ [after E A ST e⇩1] @
compT E A⇩1 ST⇩1 e⇩2 @ [after E A⇩1 ST⇩1 e⇩2] @
[ty⇩i' ST E A⇩2])"
| "compT E A ST (C∙⇩sF{D} := e⇩2) = compT E A ST e⇩2 @ [after E A ST e⇩2] @ [ty⇩i' ST E (A ⊔ 𝒜 e⇩2)]"
| "compT E A ST {i:T; e} = compT (E@[T]) (A⊖i) ST e"
| "compT E A ST (e⇩1;;e⇩2) =
(let A⇩1 = A ⊔ 𝒜 e⇩1 in
compT E A ST e⇩1 @ [after E A ST e⇩1, ty⇩i' ST E A⇩1] @
compT E A⇩1 ST e⇩2)"
| "compT E A ST (if (e) e⇩1 else e⇩2) =
(let A⇩0 = A ⊔ 𝒜 e; τ = ty⇩i' ST E A⇩0 in
compT E A ST e @ [after E A ST e, τ] @
compT E A⇩0 ST e⇩1 @ [after E A⇩0 ST e⇩1, τ] @
compT E A⇩0 ST e⇩2)"
| "compT E A ST (while (e) c) =
(let A⇩0 = A ⊔ 𝒜 e; A⇩1 = A⇩0 ⊔ 𝒜 c; τ = ty⇩i' ST E A⇩0 in
compT E A ST e @ [after E A ST e, τ] @
compT E A⇩0 ST c @ [after E A⇩0 ST c, ty⇩i' ST E A⇩1, ty⇩i' ST E A⇩0])"
| "compT E A ST (throw e) = compT E A ST e @ [after E A ST e]"
| "compT E A ST (e∙M(es)) =
compT E A ST e @ [after E A ST e] @
compTs E (A ⊔ 𝒜 e) (ty E e # ST) es"
| "compT E A ST (C∙⇩sM(es)) = compTs E A ST es"
| "compT E A ST (try e⇩1 catch(C i) e⇩2) =
compT E A ST e⇩1 @ [after E A ST e⇩1] @
[ty⇩i' (Class C#ST) E A, ty⇩i' ST (E@[Class C]) (A ⊔ ⌊{i}⌋)] @
compT (E@[Class C]) (A ⊔ ⌊{i}⌋) ST e⇩2"
| "compT E A ST (INIT C (Cs,b) ← e) = []"
| "compT E A ST (RI(C,e');Cs ← e) = []"
| "compTs E A ST [] = []"
| "compTs E A ST (e#es) = compT E A ST e @ [after E A ST e] @
compTs E (A ⊔ (𝒜 e)) (ty E e # ST) es"
definition compT⇩a :: "ty list ⇒ nat hyperset ⇒ ty list ⇒ expr⇩1 ⇒ ty⇩i' list" where
"compT⇩a E A ST e = compT E A ST e @ [after E A ST e]"
end
lemma compE⇩2_not_Nil[simp]: "P,E ⊢⇩1 e :: T ⟹ compE⇩2 e ≠ []"
by(simp add: compE⇩2_not_Nil' WT⇩1_nsub_RI)
lemma (in TC1) compT_sizes':
shows "⋀E A ST. ¬sub_RI e ⟹ size(compT E A ST e) = size(compE⇩2 e) - 1"
and "⋀E A ST. ¬sub_RIs es ⟹ size(compTs E A ST es) = size(compEs⇩2 es)"
apply(induct e and es rule: compE⇩2.induct compEs⇩2.induct)
apply(auto split:bop.splits nat_diff_split simp: compE⇩2_not_Nil')
done
lemma (in TC1) compT_sizes[simp]:
shows "⋀E A ST. P,E ⊢⇩1 e :: T ⟹ size(compT E A ST e) = size(compE⇩2 e) - 1"
and "⋀E A ST. P,E ⊢⇩1 es [::] Ts ⟹ size(compTs E A ST es) = size(compEs⇩2 es)"
using compT_sizes' WT⇩1_nsub_RI WTs⇩1_nsub_RIs by auto
lemma (in TC1) [simp]: "⋀ST E. ⌊τ⌋ ∉ set (compT E None ST e)"
and [simp]: "⋀ST E. ⌊τ⌋ ∉ set (compTs E None ST es)"
by(induct e and es rule: compT.induct compTs.induct) (simp_all add:after_def)
lemma (in TC0) pair_eq_ty⇩i'_conv:
"(⌊(ST, LT)⌋ = ty⇩i' ST⇩0 E A) =
(case A of None ⇒ False | Some A ⇒ (ST = ST⇩0 ∧ LT = ty⇩l E A))"
by(simp add:ty⇩i'_def)
lemma (in TC0) pair_conv_ty⇩i':
"⌊(ST, ty⇩l E A)⌋ = ty⇩i' ST E ⌊A⌋"
by(simp add:ty⇩i'_def)
declare (in TC0)
ty⇩i'_antimono [intro!] after_def[simp]
pair_conv_ty⇩i'[simp] pair_eq_ty⇩i'_conv[simp]
lemma (in TC1) compT_LT_prefix:
"⋀E A ST⇩0. ⟦ ⌊(ST,LT)⌋ ∈ set(compT E A ST⇩0 e); ℬ e (size E) ⟧
⟹ P ⊢ ⌊(ST,LT)⌋ ≤' ty⇩i' ST E A"
and
"⋀E A ST⇩0. ⟦ ⌊(ST,LT)⌋ ∈ set(compTs E A ST⇩0 es); ℬs es (size E) ⟧
⟹ P ⊢ ⌊(ST,LT)⌋ ≤' ty⇩i' ST E A"
proof(induct e and es rule: compT.induct compTs.induct)
case FAss thus ?case by(fastforce simp:hyperset_defs elim!:sup_state_opt_trans)
next
case BinOp thus ?case
by(fastforce simp:hyperset_defs elim!:sup_state_opt_trans split:bop.splits)
next
case Seq thus ?case by(fastforce simp:hyperset_defs elim!:sup_state_opt_trans)
next
case While thus ?case by(fastforce simp:hyperset_defs elim!:sup_state_opt_trans)
next
case Cond thus ?case by(fastforce simp:hyperset_defs elim!:sup_state_opt_trans)
next
case Block thus ?case
by(force simp add:hyperset_defs ty⇩i'_def simp del:pair_conv_ty⇩i'
elim!:sup_state_opt_trans)
next
case Call thus ?case by(fastforce simp:hyperset_defs elim!:sup_state_opt_trans)
next
case Cons_exp thus ?case
by(fastforce simp:hyperset_defs elim!:sup_state_opt_trans)
next
case TryCatch thus ?case
by(fastforce simp:hyperset_defs intro!: ty⇩i'_incr
elim!:sup_state_opt_trans)
qed (auto simp:hyperset_defs)
declare (in TC0)
ty⇩i'_antimono [rule del] after_def[simp del]
pair_conv_ty⇩i'[simp del] pair_eq_ty⇩i'_conv[simp del]
lemma [iff]: "OK None ∈ states P mxs mxl"
by(simp add: JVM_states_unfold)
lemma (in TC0) after_in_states:
"⟦ wf_prog p P; P,E ⊢⇩1 e :: T; set E ⊆ types P; set ST ⊆ types P;
size ST + max_stack e ≤ mxs ⟧
⟹ OK (after E A ST e) ∈ states P mxs mxl"
apply(subgoal_tac "size ST + 1 ≤ mxs")
apply(simp add: after_def ty⇩i'_def JVM_states_unfold ty⇩l_in_types)
apply(blast intro!:listI WT⇩1_is_type)
using max_stack1[where e=e] apply fastforce
done
lemma (in TC0) OK_ty⇩i'_in_statesI[simp]:
"⟦ set E ⊆ types P; set ST ⊆ types P; size ST ≤ mxs ⟧
⟹ OK (ty⇩i' ST E A) ∈ states P mxs mxl"
apply(simp add:ty⇩i'_def JVM_states_unfold ty⇩l_in_types)
apply(blast intro!:listI)
done
lemma is_class_type_aux: "is_class P C ⟹ is_type P (Class C)"
by(simp)
declare is_type_simps[simp del] subsetI[rule del]
theorem (in TC1) compT_states:
assumes wf: "wf_prog p P"
shows "⋀E T A ST.
⟦ P,E ⊢⇩1 e :: T; set E ⊆ types P; set ST ⊆ types P;
size ST + max_stack e ≤ mxs; size E + max_vars e ≤ mxl ⟧
⟹ OK ` set(compT E A ST e) ⊆ states P mxs mxl"
(is "⋀E T A ST. PROP ?P e E T A ST")
and "⋀E Ts A ST.
⟦ P,E ⊢⇩1 es[::]Ts; set E ⊆ types P; set ST ⊆ types P;
size ST + max_stacks es ≤ mxs; size E + max_varss es ≤ mxl ⟧
⟹ OK ` set(compTs E A ST es) ⊆ states P mxs mxl"
(is "⋀E Ts A ST. PROP ?Ps es E Ts A ST")
proof(induct e and es rule: compT.induct compTs.induct)
case new thus ?case by(simp)
next
case (Cast C e) thus ?case by (auto simp:after_in_states[OF wf])
next
case Val thus ?case by(simp)
next
case Var thus ?case by(simp)
next
case LAss thus ?case by(auto simp:after_in_states[OF wf])
next
case FAcc thus ?case by(auto simp:after_in_states[OF wf])
next
case SFAcc thus ?case by(auto simp:after_in_states[OF wf])
next
case FAss thus ?case
by(auto simp:image_Un WT⇩1_is_type[OF wf] after_in_states[OF wf])
next
case SFAss thus ?case
by(auto simp:image_Un WT⇩1_is_type[OF wf] after_in_states[OF wf])
next
case Seq thus ?case
by(auto simp:image_Un after_in_states[OF wf])
next
case BinOp thus ?case
by(auto simp:image_Un WT⇩1_is_type[OF wf] after_in_states[OF wf])
next
case Cond thus ?case
by(force simp:image_Un WT⇩1_is_type[OF wf] after_in_states[OF wf])
next
case While thus ?case
by(auto simp:image_Un WT⇩1_is_type[OF wf] after_in_states[OF wf])
next
case Block thus ?case by(auto)
next
case (TryCatch e⇩1 C i e⇩2)
moreover have "size ST + 1 ≤ mxs"
using TryCatch.prems max_stack1[where e=e⇩1] by fastforce
ultimately show ?case
by(auto simp:image_Un WT⇩1_is_type[OF wf] after_in_states[OF wf]
is_class_type_aux)
next
case Nil_exp thus ?case by simp
next
case Cons_exp thus ?case
by(auto simp:image_Un WT⇩1_is_type[OF wf] after_in_states[OF wf])
next
case throw thus ?case
by(auto simp: WT⇩1_is_type[OF wf] after_in_states[OF wf])
next
case Call thus ?case
by(auto simp:image_Un WT⇩1_is_type[OF wf] after_in_states[OF wf])
next
case SCall thus ?case
by(auto simp:image_Un WT⇩1_is_type[OF wf] after_in_states[OF wf])
next
case INIT thus ?case by simp
next
case RI thus ?case by simp
qed
declare is_type_simps[simp] subsetI[intro!]
definition shift :: "nat ⇒ ex_table ⇒ ex_table"
where
"shift n xt ≡ map (λ(from,to,C,handler,depth). (from+n,to+n,C,handler+n,depth)) xt"
lemma [simp]: "shift 0 xt = xt"
by(induct xt)(auto simp:shift_def)
lemma [simp]: "shift n [] = []"
by(simp add:shift_def)
lemma [simp]: "shift n (xt⇩1 @ xt⇩2) = shift n xt⇩1 @ shift n xt⇩2"
by(simp add:shift_def)
lemma [simp]: "shift m (shift n xt) = shift (m+n) xt"
by(induct xt)(auto simp:shift_def)
lemma [simp]: "pcs (shift n xt) = {pc+n|pc. pc ∈ pcs xt}"
apply(auto simp:shift_def pcs_def)
apply(rule_tac x = "x-n" in exI)
apply (force split:nat_diff_split)
done
lemma shift_compxE⇩2:
shows "⋀pc pc' d. shift pc (compxE⇩2 e pc' d) = compxE⇩2 e (pc' + pc) d"
and "⋀pc pc' d. shift pc (compxEs⇩2 es pc' d) = compxEs⇩2 es (pc' + pc) d"
apply(induct e and es rule: compxE⇩2.induct compxEs⇩2.induct)
apply(auto simp:shift_def ac_simps)
done
lemma compxE⇩2_size_convs[simp]:
shows "n ≠ 0 ⟹ compxE⇩2 e n d = shift n (compxE⇩2 e 0 d)"
and "n ≠ 0 ⟹ compxEs⇩2 es n d = shift n (compxEs⇩2 es 0 d)"
by(simp_all add:shift_compxE⇩2)
locale TC2 = TC1 +
fixes T⇩r :: ty and mxs :: pc
begin
definition
wt_instrs :: "instr list ⇒ ex_table ⇒ ty⇩i' list ⇒ bool"
("(⊢ _, _ /[::]/ _)" [0,0,51] 50) where
"⊢ is,xt [::] τs ⟷ size is < size τs ∧ pcs xt ⊆ {0..<size is} ∧
(∀pc< size is. P,T⇩r,mxs,size τs,xt ⊢ is!pc,pc :: τs)"
end
notation TC2.wt_instrs ("(_,_,_ ⊢/ _, _ /[::]/ _)" [50,50,50,50,50,51] 50)
lemmas (in TC2) wt_defs =
wt_instrs_def wt_instr_def app_def eff_def norm_eff_def
lemma (in TC2) [simp]: "τs ≠ [] ⟹ ⊢ [],[] [::] τs"
by (simp add: wt_defs)
lemma [simp]: "eff i P pc et None = []"
by (simp add: Effect.eff_def)
declare split_comp_eq[simp del]
lemma wt_instr_appR:
"⟦ P,T,m,mpc,xt ⊢ is!pc,pc :: τs;
pc < size is; size is < size τs; mpc ≤ size τs; mpc ≤ mpc' ⟧
⟹ P,T,m,mpc',xt ⊢ is!pc,pc :: τs@τs'"
by (fastforce simp:wt_instr_def app_def)
lemma relevant_entries_shift [simp]:
"relevant_entries P i (pc+n) (shift n xt) = shift n (relevant_entries P i pc xt)"
apply (induct xt)
apply (unfold relevant_entries_def shift_def)
apply simp
apply (auto simp add: is_relevant_entry_def)
done
lemma [simp]:
"xcpt_eff i P (pc+n) τ (shift n xt) =
map (λ(pc,τ). (pc + n, τ)) (xcpt_eff i P pc τ xt)"
apply(simp add: xcpt_eff_def)
apply(cases τ)
apply(auto simp add: shift_def)
done
lemma [simp]:
"app⇩i (i, P, pc, m, T, τ) ⟹
eff i P (pc+n) (shift n xt) (Some τ) =
map (λ(pc,τ). (pc+n,τ)) (eff i P pc xt (Some τ))"
apply(simp add:eff_def norm_eff_def)
apply(cases "i",auto)
done
lemma [simp]:
"xcpt_app i P (pc+n) mxs (shift n xt) τ = xcpt_app i P pc mxs xt τ"
by (simp add: xcpt_app_def) (auto simp add: shift_def)
lemma wt_instr_appL:
"⟦ P,T,m,mpc,xt ⊢ i,pc :: τs; pc < size τs; mpc ≤ size τs ⟧
⟹ P,T,m,mpc + size τs',shift (size τs') xt ⊢ i,pc+size τs' :: τs'@τs"
apply(auto simp:wt_instr_def app_def)
prefer 2 apply(fast)
prefer 2 apply(fast)
apply(cases "i",auto)
done
lemma wt_instr_Cons:
"⟦ P,T,m,mpc - 1,[] ⊢ i,pc - 1 :: τs;
0 < pc; 0 < mpc; pc < size τs + 1; mpc ≤ size τs + 1 ⟧
⟹ P,T,m,mpc,[] ⊢ i,pc :: τ#τs"
apply(drule wt_instr_appL[where τs' = "[τ]"])
apply arith
apply arith
apply (simp split:nat_diff_split_asm)
done
lemma wt_instr_append:
"⟦ P,T,m,mpc - size τs',[] ⊢ i,pc - size τs' :: τs;
size τs' ≤ pc; size τs' ≤ mpc; pc < size τs + size τs'; mpc ≤ size τs + size τs' ⟧
⟹ P,T,m,mpc,[] ⊢ i,pc :: τs'@τs"
apply(drule wt_instr_appL[where τs' = τs'])
apply arith
apply arith
apply (simp split:nat_diff_split_asm)
done
lemma xcpt_app_pcs:
"pc ∉ pcs xt ⟹ xcpt_app i P pc mxs xt τ"
by (auto simp add: xcpt_app_def relevant_entries_def is_relevant_entry_def pcs_def)
lemma xcpt_eff_pcs:
"pc ∉ pcs xt ⟹ xcpt_eff i P pc τ xt = []"
by (cases τ)
(auto simp add: is_relevant_entry_def xcpt_eff_def relevant_entries_def pcs_def
intro!: filter_False)
lemma pcs_shift:
"pc < n ⟹ pc ∉ pcs (shift n xt)"
by (auto simp add: shift_def pcs_def)
lemma wt_instr_appRx:
"⟦ P,T,m,mpc,xt ⊢ is!pc,pc :: τs; pc < size is; size is < size τs; mpc ≤ size τs ⟧
⟹ P,T,m,mpc,xt @ shift (size is) xt' ⊢ is!pc,pc :: τs"
by (auto simp:wt_instr_def eff_def app_def xcpt_app_pcs xcpt_eff_pcs)
lemma wt_instr_appLx:
"⟦ P,T,m,mpc,xt ⊢ i,pc :: τs; pc ∉ pcs xt' ⟧
⟹ P,T,m,mpc,xt'@xt ⊢ i,pc :: τs"
by (auto simp:wt_instr_def app_def eff_def xcpt_app_pcs xcpt_eff_pcs)
lemma (in TC2) wt_instrs_extR:
"⊢ is,xt [::] τs ⟹ ⊢ is,xt [::] τs @ τs'"
by(auto simp add:wt_instrs_def wt_instr_appR)
lemma (in TC2) wt_instrs_ext:
"⟦ ⊢ is⇩1,xt⇩1 [::] τs⇩1@τs⇩2; ⊢ is⇩2,xt⇩2 [::] τs⇩2; size τs⇩1 = size is⇩1 ⟧
⟹ ⊢ is⇩1@is⇩2, xt⇩1 @ shift (size is⇩1) xt⇩2 [::] τs⇩1@τs⇩2"
apply(clarsimp simp:wt_instrs_def)
apply(rule conjI, fastforce)
apply(rule conjI, fastforce)
apply clarsimp
apply(rule conjI, fastforce simp:wt_instr_appRx)
apply clarsimp
apply(erule_tac x = "pc - size is⇩1" in allE)+
apply(thin_tac "P ⟶ Q" for P Q)
apply(erule impE, arith)
apply(drule_tac τs' = "τs⇩1" in wt_instr_appL)
apply arith
apply simp
apply(fastforce simp add:add.commute intro!: wt_instr_appLx)
done
corollary (in TC2) wt_instrs_ext2:
"⟦ ⊢ is⇩2,xt⇩2 [::] τs⇩2; ⊢ is⇩1,xt⇩1 [::] τs⇩1@τs⇩2; size τs⇩1 = size is⇩1 ⟧
⟹ ⊢ is⇩1@is⇩2, xt⇩1 @ shift (size is⇩1) xt⇩2 [::] τs⇩1@τs⇩2"
by(rule wt_instrs_ext)
corollary (in TC2) wt_instrs_ext_prefix [trans]:
"⟦ ⊢ is⇩1,xt⇩1 [::] τs⇩1@τs⇩2; ⊢ is⇩2,xt⇩2 [::] τs⇩3;
size τs⇩1 = size is⇩1; prefix τs⇩3 τs⇩2 ⟧
⟹ ⊢ is⇩1@is⇩2, xt⇩1 @ shift (size is⇩1) xt⇩2 [::] τs⇩1@τs⇩2"
by(bestsimp simp:prefix_def elim: wt_instrs_ext dest:wt_instrs_extR)
corollary (in TC2) wt_instrs_app:
assumes is⇩1: "⊢ is⇩1,xt⇩1 [::] τs⇩1@[τ]"
assumes is⇩2: "⊢ is⇩2,xt⇩2 [::] τ#τs⇩2"
assumes s: "size τs⇩1 = size is⇩1"
shows "⊢ is⇩1@is⇩2, xt⇩1@shift (size is⇩1) xt⇩2 [::] τs⇩1@τ#τs⇩2"
proof -
from is⇩1 have "⊢ is⇩1,xt⇩1 [::] (τs⇩1@[τ])@τs⇩2"
by (rule wt_instrs_extR)
hence "⊢ is⇩1,xt⇩1 [::] τs⇩1@τ#τs⇩2" by simp
from this is⇩2 s show ?thesis by (rule wt_instrs_ext)
qed
corollary (in TC2) wt_instrs_app_last[trans]:
"⟦ ⊢ is⇩2,xt⇩2 [::] τ#τs⇩2; ⊢ is⇩1,xt⇩1 [::] τs⇩1;
last τs⇩1 = τ; size τs⇩1 = size is⇩1+1 ⟧
⟹ ⊢ is⇩1@is⇩2, xt⇩1@shift (size is⇩1) xt⇩2 [::] τs⇩1@τs⇩2"
apply(cases τs⇩1 rule:rev_cases)
apply simp
apply(simp add:wt_instrs_app)
done
corollary (in TC2) wt_instrs_append_last[trans]:
"⟦ ⊢ is,xt [::] τs; P,T⇩r,mxs,mpc,[] ⊢ i,pc :: τs;
pc = size is; mpc = size τs; size is + 1 < size τs ⟧
⟹ ⊢ is@[i],xt [::] τs"
apply(clarsimp simp add:wt_instrs_def)
apply(rule conjI, fastforce)
apply(fastforce intro!:wt_instr_appLx[where xt = "[]",simplified]
dest!:less_antisym)
done
corollary (in TC2) wt_instrs_app2:
"⟦ ⊢ is⇩2,xt⇩2 [::] τ'#τs⇩2; ⊢ is⇩1,xt⇩1 [::] τ#τs⇩1@[τ'];
xt' = xt⇩1 @ shift (size is⇩1) xt⇩2; size τs⇩1+1 = size is⇩1 ⟧
⟹ ⊢ is⇩1@is⇩2,xt' [::] τ#τs⇩1@τ'#τs⇩2"
using wt_instrs_app[where ?τs⇩1.0 = "τ # τs⇩1"] by simp
corollary (in TC2) wt_instrs_app2_simp[trans,simp]:
"⟦ ⊢ is⇩2,xt⇩2 [::] τ'#τs⇩2; ⊢ is⇩1,xt⇩1 [::] τ#τs⇩1@[τ']; size τs⇩1+1 = size is⇩1 ⟧
⟹ ⊢ is⇩1@is⇩2, xt⇩1@shift (size is⇩1) xt⇩2 [::] τ#τs⇩1@τ'#τs⇩2"
using wt_instrs_app[where ?τs⇩1.0 = "τ # τs⇩1"] by simp
corollary (in TC2) wt_instrs_Cons[simp]:
"⟦ τs ≠ []; ⊢ [i],[] [::] [τ,τ']; ⊢ is,xt [::] τ'#τs ⟧
⟹ ⊢ i#is,shift 1 xt [::] τ#τ'#τs"
using wt_instrs_app2[where ?is⇩1.0 = "[i]" and ?τs⇩1.0 = "[]" and ?is⇩2.0 = "is"
and ?xt⇩1.0 = "[]"]
by simp
corollary (in TC2) wt_instrs_Cons2[trans]:
assumes τs: "⊢ is,xt [::] τs"
assumes i: "P,T⇩r,mxs,mpc,[] ⊢ i,0 :: τ#τs"
assumes mpc: "mpc = size τs + 1"
shows "⊢ i#is,shift 1 xt [::] τ#τs"
proof -
from τs have "τs ≠ []" by (auto simp: wt_instrs_def)
with mpc i have "⊢ [i],[] [::] [τ]@τs" by (simp add: wt_instrs_def)
with τs show ?thesis by (fastforce dest: wt_instrs_ext)
qed
lemma (in TC2) wt_instrs_last_incr[trans]:
"⟦ ⊢ is,xt [::] τs@[τ]; P ⊢ τ ≤' τ' ⟧ ⟹ ⊢ is,xt [::] τs@[τ']"
apply(clarsimp simp add:wt_instrs_def wt_instr_def)
apply(rule conjI)
apply(fastforce)
apply(clarsimp)
apply(rename_tac pc' tau')
apply(erule allE, erule (1) impE)
apply(clarsimp)
apply(drule (1) bspec)
apply(clarsimp)
apply(subgoal_tac "pc' = size τs")
prefer 2
apply(clarsimp simp:app_def)
apply(drule (1) bspec)
apply(clarsimp)
apply(auto elim!:sup_state_opt_trans)
done
lemma [iff]: "xcpt_app i P pc mxs [] τ"
by (simp add: xcpt_app_def relevant_entries_def)
lemma [simp]: "xcpt_eff i P pc τ [] = []"
by (simp add: xcpt_eff_def relevant_entries_def)
lemma (in TC2) wt_New:
"⟦ is_class P C; size ST < mxs ⟧ ⟹
⊢ [New C],[] [::] [ty⇩i' ST E A, ty⇩i' (Class C#ST) E A]"
by(simp add:wt_defs ty⇩i'_def)
lemma (in TC2) wt_Cast:
"is_class P C ⟹
⊢ [Checkcast C],[] [::] [ty⇩i' (Class D # ST) E A, ty⇩i' (Class C # ST) E A]"
by(simp add: ty⇩i'_def wt_defs)
lemma (in TC2) wt_Push:
"⟦ size ST < mxs; typeof v = Some T ⟧
⟹ ⊢ [Push v],[] [::] [ty⇩i' ST E A, ty⇩i' (T#ST) E A]"
by(simp add: ty⇩i'_def wt_defs)
lemma (in TC2) wt_Pop:
"⊢ [Pop],[] [::] (ty⇩i' (T#ST) E A # ty⇩i' ST E A # τs)"
by(simp add: ty⇩i'_def wt_defs)
lemma (in TC2) wt_CmpEq:
"⟦ P ⊢ T⇩1 ≤ T⇩2 ∨ P ⊢ T⇩2 ≤ T⇩1⟧
⟹ ⊢ [CmpEq],[] [::] [ty⇩i' (T⇩2 # T⇩1 # ST) E A, ty⇩i' (Boolean # ST) E A]"
by(auto simp:ty⇩i'_def wt_defs elim!: refTE not_refTE)
lemma (in TC2) wt_IAdd:
"⊢ [IAdd],[] [::] [ty⇩i' (Integer#Integer#ST) E A, ty⇩i' (Integer#ST) E A]"
by(simp add:ty⇩i'_def wt_defs)
lemma (in TC2) wt_Load:
"⟦ size ST < mxs; size E ≤ mxl; i ∈∈ A; i < size E ⟧
⟹ ⊢ [Load i],[] [::] [ty⇩i' ST E A, ty⇩i' (E!i # ST) E A]"
by(auto simp add:ty⇩i'_def wt_defs ty⇩l_def hyperset_defs)
lemma (in TC2) wt_Store:
"⟦ P ⊢ T ≤ E!i; i < size E; size E ≤ mxl ⟧ ⟹
⊢ [Store i],[] [::] [ty⇩i' (T#ST) E A, ty⇩i' ST E (⌊{i}⌋ ⊔ A)]"
by(auto simp:hyperset_defs nth_list_update ty⇩i'_def wt_defs ty⇩l_def
intro:list_all2_all_nthI)
lemma (in TC2) wt_Get:
"⟦ P ⊢ C sees F,NonStatic:T in D ⟧ ⟹
⊢ [Getfield F D],[] [::] [ty⇩i' (Class C # ST) E A, ty⇩i' (T # ST) E A]"
by(auto simp: ty⇩i'_def wt_defs dest: sees_field_idemp sees_field_decl_above)
lemma (in TC2) wt_GetS:
"⟦ size ST < mxs; P ⊢ C sees F,Static:T in D ⟧ ⟹
⊢ [Getstatic C F D],[] [::] [ty⇩i' ST E A, ty⇩i' (T # ST) E A]"
by(auto simp: ty⇩i'_def wt_defs dest: sees_field_idemp sees_field_decl_above)
lemma (in TC2) wt_Put:
"⟦ P ⊢ C sees F,NonStatic:T in D; P ⊢ T' ≤ T ⟧ ⟹
⊢ [Putfield F D],[] [::] [ty⇩i' (T' # Class C # ST) E A, ty⇩i' ST E A]"
by(auto intro: sees_field_idemp sees_field_decl_above simp: ty⇩i'_def wt_defs)
lemma (in TC2) wt_PutS:
"⟦ P ⊢ C sees F,Static:T in D; P ⊢ T' ≤ T ⟧ ⟹
⊢ [Putstatic C F D],[] [::] [ty⇩i' (T' # ST) E A, ty⇩i' ST E A]"
by(auto intro: sees_field_idemp sees_field_decl_above simp: ty⇩i'_def wt_defs)
lemma (in TC2) wt_Throw:
"⊢ [Throw],[] [::] [ty⇩i' (Class C # ST) E A, τ']"
by(auto simp: ty⇩i'_def wt_defs)
lemma (in TC2) wt_IfFalse:
"⟦ 2 ≤ i; nat i < size τs + 2; P ⊢ ty⇩i' ST E A ≤' τs ! nat(i - 2) ⟧
⟹ ⊢ [IfFalse i],[] [::] ty⇩i' (Boolean # ST) E A # ty⇩i' ST E A # τs"
by(simp add: ty⇩i'_def wt_defs eval_nat_numeral nat_diff_distrib)
lemma wt_Goto:
"⟦ 0 ≤ int pc + i; nat (int pc + i) < size τs; size τs ≤ mpc;
P ⊢ τs!pc ≤' τs ! nat (int pc + i) ⟧
⟹ P,T,mxs,mpc,[] ⊢ Goto i,pc :: τs"
by(clarsimp simp add: TC2.wt_defs)
lemma (in TC2) wt_Invoke:
"⟦ size es = size Ts'; P ⊢ C sees M,NonStatic: Ts→T = m in D; P ⊢ Ts' [≤] Ts ⟧
⟹ ⊢ [Invoke M (size es)],[] [::] [ty⇩i' (rev Ts' @ Class C # ST) E A, ty⇩i' (T#ST) E A]"
by(fastforce simp add: ty⇩i'_def wt_defs)
lemma (in TC2) wt_Invokestatic:
"⟦ size ST < mxs; size es = size Ts'; M ≠ clinit;
P ⊢ C sees M,Static: Ts→T = m in D; P ⊢ Ts' [≤] Ts ⟧
⟹ ⊢ [Invokestatic C M (size es)],[] [::] [ty⇩i' (rev Ts' @ ST) E A, ty⇩i' (T#ST) E A]"
by(fastforce simp add: ty⇩i'_def wt_defs)
corollary (in TC2) wt_instrs_app3[simp]:
"⟦ ⊢ is⇩2,[] [::] (τ' # τs⇩2); ⊢ is⇩1,xt⇩1 [::] τ # τs⇩1 @ [τ']; size τs⇩1+1 = size is⇩1⟧
⟹ ⊢ (is⇩1 @ is⇩2),xt⇩1 [::] τ # τs⇩1 @ τ' # τs⇩2"
using wt_instrs_app2[where ?xt⇩2.0 = "[]"] by (simp add:shift_def)
corollary (in TC2) wt_instrs_Cons3[simp]:
"⟦ τs ≠ []; ⊢ [i],[] [::] [τ,τ']; ⊢ is,[] [::] τ'#τs ⟧
⟹ ⊢ (i # is),[] [::] τ # τ' # τs"
using wt_instrs_Cons[where ?xt = "[]"]
by (simp add:shift_def)
declare nth_append[simp del]
declare [[simproc del: list_to_set_comprehension]]
lemma (in TC2) wt_instrs_xapp[trans]:
"⟦ ⊢ is⇩1 @ is⇩2, xt [::] τs⇩1 @ ty⇩i' (Class C # ST) E A # τs⇩2;
∀τ ∈ set τs⇩1. ∀ST' LT'. τ = Some(ST',LT') ⟶
size ST ≤ size ST' ∧ P ⊢ Some (drop (size ST' - size ST) ST',LT') ≤' ty⇩i' ST E A;
size is⇩1 = size τs⇩1; is_class P C; size ST < mxs ⟧ ⟹
⊢ is⇩1 @ is⇩2, xt @ [(0,size is⇩1 - 1,C,size is⇩1,size ST)] [::] τs⇩1 @ ty⇩i' (Class C # ST) E A # τs⇩2"
apply(simp add:wt_instrs_def)
apply(rule conjI)
apply(clarsimp)
apply arith
apply clarsimp
apply(erule allE, erule (1) impE)
apply(clarsimp simp add: wt_instr_def app_def eff_def)
apply(rule conjI)
apply (thin_tac "∀x∈ A ∪ B. P x" for A B P)
apply (thin_tac "∀x∈ A ∪ B. P x" for A B P)
apply (clarsimp simp add: xcpt_app_def relevant_entries_def)
apply (simp add: nth_append is_relevant_entry_def split!: if_splits)
apply (drule_tac x="τs⇩1!pc" in bspec)
apply (blast intro: nth_mem)
apply fastforce
apply (rule conjI)
apply clarsimp
apply (erule disjE, blast)
apply (erule disjE, blast)
apply (clarsimp simp add: xcpt_eff_def relevant_entries_def split: if_split_asm)
apply clarsimp
apply (erule disjE, blast)
apply (erule disjE, blast)
apply (clarsimp simp add: xcpt_eff_def relevant_entries_def split: if_split_asm)
apply (simp add: nth_append is_relevant_entry_def split: if_split_asm)
apply (drule_tac x = "τs⇩1!pc" in bspec)
apply (blast intro: nth_mem)
apply (fastforce simp add: ty⇩i'_def)
done
declare [[simproc add: list_to_set_comprehension]]
declare nth_append[simp]
lemma drop_Cons_Suc:
"⋀xs. drop n xs = y#ys ⟹ drop (Suc n) xs = ys"
apply (induct n)
apply simp
apply (simp add: drop_Suc)
done
lemma drop_mess:
"⟦Suc (length xs⇩0) ≤ length xs; drop (length xs - Suc (length xs⇩0)) xs = x # xs⇩0⟧
⟹ drop (length xs - length xs⇩0) xs = xs⇩0"
apply (cases xs)
apply simp
apply (simp add: Suc_diff_le)
apply (case_tac "length list - length xs⇩0")
apply simp
apply (simp add: drop_Cons_Suc)
done
declare (in TC0)
after_def[simp] pair_eq_ty⇩i'_conv[simp]
lemma (in TC1) compT_ST_prefix:
"⋀E A ST⇩0. ⌊(ST,LT)⌋ ∈ set(compT E A ST⇩0 e) ⟹
size ST⇩0 ≤ size ST ∧ drop (size ST - size ST⇩0) ST = ST⇩0"
and
"⋀E A ST⇩0. ⌊(ST,LT)⌋ ∈ set(compTs E A ST⇩0 es) ⟹
size ST⇩0 ≤ size ST ∧ drop (size ST - size ST⇩0) ST = ST⇩0"
proof(induct e and es rule: compT.induct compTs.induct)
case (FAss e⇩1 F D e⇩2)
moreover {
let ?ST⇩0 = "ty E e⇩1 # ST⇩0"
fix A assume "⌊(ST, LT)⌋ ∈ set (compT E A ?ST⇩0 e⇩2)"
with FAss
have "length ?ST⇩0 ≤ length ST ∧ drop (size ST - size ?ST⇩0) ST = ?ST⇩0" by blast
hence ?case by (clarsimp simp add: drop_mess)
}
ultimately show ?case by auto
next
case TryCatch thus ?case by auto
next
case Block thus ?case by auto
next
case Seq thus ?case by auto
next
case While thus ?case by auto
next
case Cond thus ?case by auto
next
case (Call e M es)
moreover {
let ?ST⇩0 = "ty E e # ST⇩0"
fix A assume "⌊(ST, LT)⌋ ∈ set (compTs E A ?ST⇩0 es)"
with Call
have "length ?ST⇩0 ≤ length ST ∧ drop (size ST - size ?ST⇩0) ST = ?ST⇩0" by blast
hence ?case by (clarsimp simp add: drop_mess)
}
ultimately show ?case by auto
next
case (Cons_exp e es)
moreover {
let ?ST⇩0 = "ty E e # ST⇩0"
fix A assume "⌊(ST, LT)⌋ ∈ set (compTs E A ?ST⇩0 es)"
with Cons_exp
have "length ?ST⇩0 ≤ length ST ∧ drop (size ST - size ?ST⇩0) ST = ?ST⇩0" by blast
hence ?case by (clarsimp simp add: drop_mess)
}
ultimately show ?case by auto
next
case (BinOp e⇩1 bop e⇩2)
moreover {
let ?ST⇩0 = "ty E e⇩1 # ST⇩0"
fix A assume "⌊(ST, LT)⌋ ∈ set (compT E A ?ST⇩0 e⇩2)"
with BinOp
have "length ?ST⇩0 ≤ length ST ∧ drop (size ST - size ?ST⇩0) ST = ?ST⇩0" by blast
hence ?case by (clarsimp simp add: drop_mess)
}
ultimately show ?case by auto
next
case new thus ?case by auto
next
case Val thus ?case by auto
next
case Cast thus ?case by auto
next
case Var thus ?case by auto
next
case LAss thus ?case by auto
next
case throw thus ?case by auto
next
case FAcc thus ?case by auto
next
case SFAcc thus ?case by auto
next
case SFAss thus ?case by auto
next
case (SCall C M es) thus ?case by auto
next
case INIT thus ?case by auto
next
case RI thus ?case by auto
next
case Nil_exp thus ?case by auto
qed
declare (in TC0)
after_def[simp del] pair_eq_ty⇩i'_conv[simp del]
lemma fun_of_simp [simp]: "fun_of S x y = ((x,y) ∈ S)"
by (simp add: fun_of_def)
theorem (in TC2) compT_wt_instrs: "⋀E T A ST.
⟦ P,E ⊢⇩1 e :: T; 𝒟 e A; ℬ e (size E);
size ST + max_stack e ≤ mxs; size E + max_vars e ≤ mxl ⟧
⟹ ⊢ compE⇩2 e, compxE⇩2 e 0 (size ST) [::]
ty⇩i' ST E A # compT E A ST e @ [after E A ST e]"
(is "⋀E T A ST. PROP ?P e E T A ST")
and "⋀E Ts A ST.
⟦ P,E ⊢⇩1 es[::]Ts; 𝒟s es A; ℬs es (size E);
size ST + max_stacks es ≤ mxs; size E + max_varss es ≤ mxl ⟧
⟹ let τs = ty⇩i' ST E A # compTs E A ST es in
⊢ compEs⇩2 es,compxEs⇩2 es 0 (size ST) [::] τs ∧
last τs = ty⇩i' (rev Ts @ ST) E (A ⊔ 𝒜s es)"
(is "⋀E Ts A ST. PROP ?Ps es E Ts A ST")
proof(induct e and es rule: compxE⇩2.induct compxEs⇩2.induct)
case (TryCatch e⇩1 C i e⇩2)
hence [simp]: "i = size E" by simp
have wt⇩1: "P,E ⊢⇩1 e⇩1 :: T" and wt⇩2: "P,E@[Class C] ⊢⇩1 e⇩2 :: T"
and "class": "is_class P C" using TryCatch by auto
let ?A⇩1 = "A ⊔ 𝒜 e⇩1" let ?A⇩i = "A ⊔ ⌊{i}⌋" let ?E⇩i = "E @ [Class C]"
let ?τ = "ty⇩i' ST E A" let ?τs⇩1 = "compT E A ST e⇩1"
let ?τ⇩1 = "ty⇩i' (T#ST) E ?A⇩1" let ?τ⇩2 = "ty⇩i' (Class C#ST) E A"
let ?τ⇩3 = "ty⇩i' ST ?E⇩i ?A⇩i" let ?τs⇩2 = "compT ?E⇩i ?A⇩i ST e⇩2"
let ?τ⇩2' = "ty⇩i' (T#ST) ?E⇩i (?A⇩i ⊔ 𝒜 e⇩2)"
let ?τ' = "ty⇩i' (T#ST) E (A ⊔ 𝒜 e⇩1 ⊓ (𝒜 e⇩2 ⊖ i))"
let ?go = "Goto (int(size(compE⇩2 e⇩2)) + 2)"
have "PROP ?P e⇩2 ?E⇩i T ?A⇩i ST" by fact
hence "⊢ compE⇩2 e⇩2,compxE⇩2 e⇩2 0 (size ST) [::] (?τ⇩3 # ?τs⇩2) @ [?τ⇩2']"
using TryCatch.prems by(auto simp:after_def)
also have "?A⇩i ⊔ 𝒜 e⇩2 = (A ⊔ 𝒜 e⇩2) ⊔ ⌊{size E}⌋"
by(fastforce simp:hyperset_defs)
also have "P ⊢ ty⇩i' (T#ST) ?E⇩i … ≤' ty⇩i' (T#ST) E (A ⊔ 𝒜 e⇩2)"
by(simp add:hyperset_defs ty⇩l_incr ty⇩i'_def)
also have "P ⊢ … ≤' ty⇩i' (T#ST) E (A ⊔ 𝒜 e⇩1 ⊓ (𝒜 e⇩2 ⊖ i))"
by(auto intro!: ty⇩l_antimono simp:hyperset_defs ty⇩i'_def)
also have "(?τ⇩3 # ?τs⇩2) @ [?τ'] = ?τ⇩3 # ?τs⇩2 @ [?τ']" by simp
also have "⊢ [Store i],[] [::] ?τ⇩2 # [] @ [?τ⇩3]"
using TryCatch.prems
by(auto simp:nth_list_update wt_defs ty⇩i'_def ty⇩l_def
list_all2_conv_all_nth hyperset_defs)
also have "[] @ (?τ⇩3 # ?τs⇩2 @ [?τ']) = (?τ⇩3 # ?τs⇩2 @ [?τ'])" by simp
also have "P,T⇩r,mxs,size(compE⇩2 e⇩2)+3,[] ⊢ ?go,0 :: ?τ⇩1#?τ⇩2#?τ⇩3#?τs⇩2 @ [?τ']" using wt⇩2
by (auto simp: hyperset_defs ty⇩i'_def wt_defs nth_Cons nat_add_distrib
fun_of_def intro: ty⇩l_antimono list_all2_refl split:nat.split)
also have "⊢ compE⇩2 e⇩1,compxE⇩2 e⇩1 0 (size ST) [::] ?τ # ?τs⇩1 @ [?τ⇩1]"
using TryCatch by(auto simp:after_def)
also have "?τ # ?τs⇩1 @ ?τ⇩1 # ?τ⇩2 # ?τ⇩3 # ?τs⇩2 @ [?τ'] =
(?τ # ?τs⇩1 @ [?τ⇩1]) @ ?τ⇩2 # ?τ⇩3 # ?τs⇩2 @ [?τ']" by simp
also have "compE⇩2 e⇩1 @ ?go # [Store i] @ compE⇩2 e⇩2 =
(compE⇩2 e⇩1 @ [?go]) @ (Store i # compE⇩2 e⇩2)" by simp
also
let "?Q τ" = "∀ST' LT'. τ = ⌊(ST', LT')⌋ ⟶
size ST ≤ size ST' ∧ P ⊢ Some (drop (size ST' - size ST) ST',LT') ≤' ty⇩i' ST E A"
{
have "?Q (ty⇩i' ST E A)" by (clarsimp simp add: ty⇩i'_def)
moreover have "?Q (ty⇩i' (T # ST) E ?A⇩1)"
by (fastforce simp add: ty⇩i'_def hyperset_defs intro!: ty⇩l_antimono)
moreover have "⋀τ. τ ∈ set (compT E A ST e⇩1) ⟹ ?Q τ" using TryCatch.prems
by clarsimp (frule compT_ST_prefix,
fastforce dest!: compT_LT_prefix simp add: ty⇩i'_def)
ultimately
have "∀τ∈set (ty⇩i' ST E A # compT E A ST e⇩1 @ [ty⇩i' (T # ST) E ?A⇩1]). ?Q τ"
by auto
}
also from TryCatch.prems max_stack1[OF wt⇩1] have "size ST + 1 ≤ mxs" by auto
ultimately show ?case using wt⇩1 wt⇩2 TryCatch.prems "class"
by (simp add:after_def)
next
case new thus ?case by(auto simp add:after_def wt_New)
next
case (BinOp e⇩1 bop e⇩2)
let ?op = "case bop of Eq ⇒ [CmpEq] | Add ⇒ [IAdd]"
have T: "P,E ⊢⇩1 e⇩1 «bop» e⇩2 :: T" by fact
then obtain T⇩1 T⇩2 where T⇩1: "P,E ⊢⇩1 e⇩1 :: T⇩1" and T⇩2: "P,E ⊢⇩1 e⇩2 :: T⇩2" and
bopT: "case bop of Eq ⇒ (P ⊢ T⇩1 ≤ T⇩2 ∨ P ⊢ T⇩2 ≤ T⇩1) ∧ T = Boolean
| Add ⇒ T⇩1 = Integer ∧ T⇩2 = Integer ∧ T = Integer" by auto
let ?A⇩1 = "A ⊔ 𝒜 e⇩1" let ?A⇩2 = "?A⇩1 ⊔ 𝒜 e⇩2"
let ?τ = "ty⇩i' ST E A" let ?τs⇩1 = "compT E A ST e⇩1"
let ?τ⇩1 = "ty⇩i' (T⇩1#ST) E ?A⇩1" let ?τs⇩2 = "compT E ?A⇩1 (T⇩1#ST) e⇩2"
let ?τ⇩2 = "ty⇩i' (T⇩2#T⇩1#ST) E ?A⇩2" let ?τ' = "ty⇩i' (T#ST) E ?A⇩2"
from bopT have "⊢ ?op,[] [::] [?τ⇩2,?τ']"
by (cases bop) (auto simp add: wt_CmpEq wt_IAdd)
also have "PROP ?P e⇩2 E T⇩2 ?A⇩1 (T⇩1#ST)" by fact
with BinOp.prems T⇩2
have "⊢ compE⇩2 e⇩2, compxE⇩2 e⇩2 0 (size (T⇩1#ST)) [::] ?τ⇩1#?τs⇩2@[?τ⇩2]"
by (auto simp: after_def)
also from BinOp T⇩1 have "⊢ compE⇩2 e⇩1, compxE⇩2 e⇩1 0 (size ST) [::] ?τ#?τs⇩1@[?τ⇩1]"
by (auto simp: after_def)
finally show ?case using T T⇩1 T⇩2 by (simp add: after_def hyperUn_assoc)
next
case (Cons_exp e es)
have "P,E ⊢⇩1 e # es [::] Ts" by fact
then obtain T⇩e Ts' where
T⇩e: "P,E ⊢⇩1 e :: T⇩e" and Ts': "P,E ⊢⇩1 es [::] Ts'" and
Ts: "Ts = T⇩e#Ts'" by auto
let ?A⇩e = "A ⊔ 𝒜 e"
let ?τ = "ty⇩i' ST E A" let ?τs⇩e = "compT E A ST e"
let ?τ⇩e = "ty⇩i' (T⇩e#ST) E ?A⇩e" let ?τs' = "compTs E ?A⇩e (T⇩e#ST) es"
let ?τs = "?τ # ?τs⇩e @ (?τ⇩e # ?τs')"
have Ps: "PROP ?Ps es E Ts' ?A⇩e (T⇩e#ST)" by fact
with Cons_exp.prems T⇩e Ts'
have "⊢ compEs⇩2 es, compxEs⇩2 es 0 (size (T⇩e#ST)) [::] ?τ⇩e#?τs'" by (simp add: after_def)
also from Cons_exp T⇩e have "⊢ compE⇩2 e, compxE⇩2 e 0 (size ST) [::] ?τ#?τs⇩e@[?τ⇩e]"
by (auto simp: after_def)
moreover
from Ps Cons_exp.prems T⇩e Ts' Ts
have "last ?τs = ty⇩i' (rev Ts@ST) E (?A⇩e ⊔ 𝒜s es)" by simp
ultimately show ?case using T⇩e by (simp add: after_def hyperUn_assoc)
next
case (FAss e⇩1 F D e⇩2)
hence Void: "P,E ⊢⇩1 e⇩1∙F{D} := e⇩2 :: Void" by auto
then obtain C T T' where
C: "P,E ⊢⇩1 e⇩1 :: Class C" and sees: "P ⊢ C sees F,NonStatic:T in D" and
T': "P,E ⊢⇩1 e⇩2 :: T'" and T'_T: "P ⊢ T' ≤ T" by auto
let ?A⇩1 = "A ⊔ 𝒜 e⇩1" let ?A⇩2 = "?A⇩1 ⊔ 𝒜 e⇩2"
let ?τ = "ty⇩i' ST E A" let ?τs⇩1 = "compT E A ST e⇩1"
let ?τ⇩1 = "ty⇩i' (Class C#ST) E ?A⇩1" let ?τs⇩2 = "compT E ?A⇩1 (Class C#ST) e⇩2"
let ?τ⇩2 = "ty⇩i' (T'#Class C#ST) E ?A⇩2" let ?τ⇩3 = "ty⇩i' ST E ?A⇩2"
let ?τ' = "ty⇩i' (Void#ST) E ?A⇩2"
from FAss.prems sees T'_T
have "⊢ [Putfield F D,Push Unit],[] [::] [?τ⇩2,?τ⇩3,?τ']"
by (fastforce simp add: wt_Push wt_Put)
also have "PROP ?P e⇩2 E T' ?A⇩1 (Class C#ST)" by fact
with FAss.prems T'
have "⊢ compE⇩2 e⇩2, compxE⇩2 e⇩2 0 (size ST+1) [::] ?τ⇩1#?τs⇩2@[?τ⇩2]"
by (auto simp add: after_def hyperUn_assoc)
also from FAss C have "⊢ compE⇩2 e⇩1, compxE⇩2 e⇩1 0 (size ST) [::] ?τ#?τs⇩1@[?τ⇩1]"
by (auto simp add: after_def)
finally show ?case using Void C T' by (simp add: after_def hyperUn_assoc)
next
case (SFAss C F D e⇩2)
hence Void: "P,E ⊢⇩1 C∙⇩sF{D} := e⇩2 :: Void" by auto
then obtain T T' where
sees: "P ⊢ C sees F,Static:T in D" and
T': "P,E ⊢⇩1 e⇩2 :: T'" and T'_T: "P ⊢ T' ≤ T" by auto
let ?A⇩2 = "A ⊔ 𝒜 e⇩2"
let ?τ = "ty⇩i' ST E A" let ?τs⇩2 = "compT E A ST e⇩2"
let ?τ⇩2 = "ty⇩i' (T'#ST) E ?A⇩2" let ?τ⇩3 = "ty⇩i' ST E ?A⇩2"
let ?τ' = "ty⇩i' (Void#ST) E ?A⇩2"
from SFAss.prems sees T'_T max_stack1[OF T']
have "⊢ [Putstatic C F D,Push Unit],[] [::] [?τ⇩2,?τ⇩3,?τ']"
by (fastforce simp add: wt_Push wt_PutS)
also have "PROP ?P e⇩2 E T' A ST" by fact
with SFAss.prems T'
have "⊢ compE⇩2 e⇩2, compxE⇩2 e⇩2 0 (size ST) [::] ?τ#?τs⇩2@[?τ⇩2]"
by (auto simp add: after_def hyperUn_assoc)
finally show ?case using Void T' by (simp add: after_def hyperUn_assoc)
next
case Val thus ?case by(auto simp:after_def wt_Push)
next
case Cast thus ?case by (auto simp:after_def wt_Cast)
next
case (Block i T⇩i e)
let ?τs = "ty⇩i' ST E A # compT (E @ [T⇩i]) (A⊖i) ST e"
have IH: "PROP ?P e (E@[T⇩i]) T (A⊖i) ST" by fact
hence "⊢ compE⇩2 e, compxE⇩2 e 0 (size ST) [::]
?τs @ [ty⇩i' (T#ST) (E@[T⇩i]) (A⊖(size E) ⊔ 𝒜 e)]"
using Block.prems by (auto simp add: after_def)
also have "P ⊢ ty⇩i' (T # ST) (E@[T⇩i]) (A ⊖ size E ⊔ 𝒜 e) ≤'
ty⇩i' (T # ST) (E@[T⇩i]) ((A ⊔ 𝒜 e) ⊖ size E)"
by(auto simp add:hyperset_defs intro: ty⇩i'_antimono)
also have "… = ty⇩i' (T # ST) E (A ⊔ 𝒜 e)" by simp
also have "P ⊢ … ≤' ty⇩i' (T # ST) E (A ⊔ (𝒜 e ⊖ i))"
by(auto simp add:hyperset_defs intro: ty⇩i'_antimono)
finally show ?case using Block.prems by(simp add: after_def)
next
case Var thus ?case by(auto simp:after_def wt_Load)
next
case FAcc thus ?case by(auto simp:after_def wt_Get)
next
case SFAcc thus ?case by(auto simp: after_def wt_GetS)
next
case (LAss i e)
then obtain T' where wt: "P,E ⊢⇩1 e :: T'" by auto
show ?case using max_stack1[OF wt] LAss
by(auto simp: hyper_insert_comm after_def wt_Store wt_Push)
next
case Nil_exp thus ?case by auto
next
case throw thus ?case by(auto simp add: after_def wt_Throw)
next
case (While e c)
obtain Tc where wte: "P,E ⊢⇩1 e :: Boolean" and wtc: "P,E ⊢⇩1 c :: Tc"
and [simp]: "T = Void" using While by auto
have [simp]: "ty E (while (e) c) = Void" using While by simp
let ?A⇩0 = "A ⊔ 𝒜 e" let ?A⇩1 = "?A⇩0 ⊔ 𝒜 c"
let ?τ = "ty⇩i' ST E A" let ?τs⇩e = "compT E A ST e"
let ?τ⇩e = "ty⇩i' (Boolean#ST) E ?A⇩0" let ?τ⇩1 = "ty⇩i' ST E ?A⇩0"
let ?τs⇩c = "compT E ?A⇩0 ST c" let ?τ⇩c = "ty⇩i' (Tc#ST) E ?A⇩1"
let ?τ⇩2 = "ty⇩i' ST E ?A⇩1" let ?τ' = "ty⇩i' (Void#ST) E ?A⇩0"
let ?τs = "(?τ # ?τs⇩e @ [?τ⇩e]) @ ?τ⇩1 # ?τs⇩c @ [?τ⇩c, ?τ⇩2, ?τ⇩1, ?τ']"
have "⊢ [],[] [::] [] @ ?τs" by(simp add:wt_instrs_def)
also
have "PROP ?P e E Boolean A ST" by fact
hence "⊢ compE⇩2 e,compxE⇩2 e 0 (size ST) [::] ?τ # ?τs⇩e @ [?τ⇩e]"
using While.prems by (auto simp:after_def)
also
have "[] @ ?τs = (?τ # ?τs⇩e) @ ?τ⇩e # ?τ⇩1 # ?τs⇩c @ [?τ⇩c,?τ⇩2,?τ⇩1,?τ']" by simp
also
let ?n⇩e = "size(compE⇩2 e)" let ?n⇩c = "size(compE⇩2 c)"
let ?if = "IfFalse (int ?n⇩c + 3)"
have "⊢ [?if],[] [::] ?τ⇩e # ?τ⇩1 # ?τs⇩c @ [?τ⇩c, ?τ⇩2, ?τ⇩1, ?τ']" using wtc
by(simp add: wt_instr_Cons wt_instr_append wt_IfFalse
nat_add_distrib split: nat_diff_split)
also
have "(?τ # ?τs⇩e) @ (?τ⇩e # ?τ⇩1 # ?τs⇩c @ [?τ⇩c, ?τ⇩2, ?τ⇩1, ?τ']) = ?τs" by simp
also
have "PROP ?P c E Tc ?A⇩0 ST" by fact
hence "⊢ compE⇩2 c,compxE⇩2 c 0 (size ST) [::] ?τ⇩1 # ?τs⇩c @ [?τ⇩c]"
using While.prems wtc by (auto simp:after_def)
also have "?τs = (?τ # ?τs⇩e @ [?τ⇩e,?τ⇩1] @ ?τs⇩c) @ [?τ⇩c,?τ⇩2,?τ⇩1,?τ']" by simp
also have "⊢ [Pop],[] [::] [?τ⇩c, ?τ⇩2]" by(simp add:wt_Pop)
also have "(?τ # ?τs⇩e @ [?τ⇩e,?τ⇩1] @ ?τs⇩c) @ [?τ⇩c,?τ⇩2,?τ⇩1,?τ'] = ?τs" by simp
also let ?go = "Goto (-int(?n⇩c+?n⇩e+2))"
have "P ⊢ ?τ⇩2 ≤' ?τ" by(fastforce intro: ty⇩i'_antimono simp: hyperset_defs)
hence "P,T⇩r,mxs,size ?τs,[] ⊢ ?go,?n⇩e+?n⇩c+2 :: ?τs" using wte wtc
by(simp add: wt_Goto split: nat_diff_split)
also have "?τs = (?τ # ?τs⇩e @ [?τ⇩e,?τ⇩1] @ ?τs⇩c @ [?τ⇩c, ?τ⇩2]) @ [?τ⇩1, ?τ']"
by simp
also have "⊢ [Push Unit],[] [::] [?τ⇩1,?τ']"
using While.prems max_stack1[OF wtc] by(auto simp add:wt_Push)
finally show ?case using wtc wte
by (simp add:after_def)
next
case (Cond e e⇩1 e⇩2)
obtain T⇩1 T⇩2 where wte: "P,E ⊢⇩1 e :: Boolean"
and wt⇩1: "P,E ⊢⇩1 e⇩1 :: T⇩1" and wt⇩2: "P,E ⊢⇩1 e⇩2 :: T⇩2"
and sub⇩1: "P ⊢ T⇩1 ≤ T" and sub⇩2: "P ⊢ T⇩2 ≤ T"
using Cond by auto
have [simp]: "ty E (if (e) e⇩1 else e⇩2) = T" using Cond by simp
let ?A⇩0 = "A ⊔ 𝒜 e" let ?A⇩2 = "?A⇩0 ⊔ 𝒜 e⇩2" let ?A⇩1 = "?A⇩0 ⊔ 𝒜 e⇩1"
let ?A' = "?A⇩0 ⊔ 𝒜 e⇩1 ⊓ 𝒜 e⇩2"
let ?τ⇩2 = "ty⇩i' ST E ?A⇩0" let ?τ' = "ty⇩i' (T#ST) E ?A'"
let ?τs⇩2 = "compT E ?A⇩0 ST e⇩2"
have "PROP ?P e⇩2 E T⇩2 ?A⇩0 ST" by fact
hence "⊢ compE⇩2 e⇩2, compxE⇩2 e⇩2 0 (size ST) [::] (?τ⇩2#?τs⇩2) @ [ty⇩i' (T⇩2#ST) E ?A⇩2]"
using Cond.prems wt⇩2 by(auto simp add:after_def)
also have "P ⊢ ty⇩i' (T⇩2#ST) E ?A⇩2 ≤' ?τ'" using sub⇩2
by(auto simp add: hyperset_defs ty⇩i'_def intro!: ty⇩l_antimono)
also
let ?τ⇩3 = "ty⇩i' (T⇩1 # ST) E ?A⇩1"
let ?g⇩2 = "Goto(int (size (compE⇩2 e⇩2) + 1))"
from sub⇩1 have "P,T⇩r,mxs,size(compE⇩2 e⇩2)+2,[] ⊢ ?g⇩2,0 :: ?τ⇩3#(?τ⇩2#?τs⇩2)@[?τ']" using wt⇩2
by(auto simp: hyperset_defs wt_defs nth_Cons ty⇩i'_def
split:nat.split intro!: ty⇩l_antimono)
also
let ?τs⇩1 = "compT E ?A⇩0 ST e⇩1"
have "PROP ?P e⇩1 E T⇩1 ?A⇩0 ST" by fact
hence "⊢ compE⇩2 e⇩1,compxE⇩2 e⇩1 0 (size ST) [::] ?τ⇩2 # ?τs⇩1 @ [?τ⇩3]"
using Cond.prems wt⇩1 by(auto simp add:after_def)
also
let ?τs⇩1⇩2 = "?τ⇩2 # ?τs⇩1 @ ?τ⇩3 # (?τ⇩2 # ?τs⇩2) @ [?τ']"
let ?τ⇩1 = "ty⇩i' (Boolean#ST) E ?A⇩0"
let ?g⇩1 = "IfFalse(int (size (compE⇩2 e⇩1) + 2))"
let ?code = "compE⇩2 e⇩1 @ ?g⇩2 # compE⇩2 e⇩2"
have "⊢ [?g⇩1],[] [::] [?τ⇩1] @ ?τs⇩1⇩2" using wt⇩1
by(simp add: wt_IfFalse nat_add_distrib split:nat_diff_split)
also (wt_instrs_ext2) have "[?τ⇩1] @ ?τs⇩1⇩2 = ?τ⇩1 # ?τs⇩1⇩2" by simp also
let ?τ = "ty⇩i' ST E A"
have "PROP ?P e E Boolean A ST" by fact
hence "⊢ compE⇩2 e, compxE⇩2 e 0 (size ST) [::] ?τ # compT E A ST e @ [?τ⇩1]"
using Cond.prems wte by(auto simp add:after_def)
finally show ?case using wte wt⇩1 wt⇩2 by(simp add:after_def hyperUn_assoc)
next
case (Call e M es)
obtain C D Ts m Ts' where C: "P,E ⊢⇩1 e :: Class C"
and "method": "P ⊢ C sees M,NonStatic:Ts → T = m in D"
and wtes: "P,E ⊢⇩1 es [::] Ts'" and subs: "P ⊢ Ts' [≤] Ts"
using Call.prems by auto
from wtes have same_size: "size es = size Ts'" by(rule WTs⇩1_same_size)
let ?A⇩0 = "A ⊔ 𝒜 e" let ?A⇩1 = "?A⇩0 ⊔ 𝒜s es"
let ?τ = "ty⇩i' ST E A" let ?τs⇩e = "compT E A ST e"
let ?τ⇩e = "ty⇩i' (Class C # ST) E ?A⇩0"
let ?τs⇩e⇩s = "compTs E ?A⇩0 (Class C # ST) es"
let ?τ⇩1 = "ty⇩i' (rev Ts' @ Class C # ST) E ?A⇩1"
let ?τ' = "ty⇩i' (T # ST) E ?A⇩1"
have "⊢ [Invoke M (size es)],[] [::] [?τ⇩1,?τ']"
by(rule wt_Invoke[OF same_size "method" subs])
also
have "PROP ?Ps es E Ts' ?A⇩0 (Class C # ST)" by fact
hence "⊢ compEs⇩2 es,compxEs⇩2 es 0 (size ST+1) [::] ?τ⇩e # ?τs⇩e⇩s"
"last (?τ⇩e # ?τs⇩e⇩s) = ?τ⇩1"
using Call.prems wtes by(auto simp add:after_def)
also have "(?τ⇩e # ?τs⇩e⇩s) @ [?τ'] = ?τ⇩e # ?τs⇩e⇩s @ [?τ']" by simp
also have "⊢ compE⇩2 e,compxE⇩2 e 0 (size ST) [::] ?τ # ?τs⇩e @ [?τ⇩e]"
using Call C by(auto simp add:after_def)
finally show ?case using Call.prems C wtes by(simp add:after_def hyperUn_assoc)
next
case (SCall C M es)
obtain D Ts m Ts' where "method": "P ⊢ C sees M,Static:Ts → T = m in D"
and wtes: "P,E ⊢⇩1 es [::] Ts'" and subs: "P ⊢ Ts' [≤] Ts"
using SCall.prems by auto
from SCall.prems(1) have nclinit: "M ≠ clinit" by auto
from wtes have same_size: "size es = size Ts'" by(rule WTs⇩1_same_size)
have mxs: "length ST < mxs" using WT⇩1_nsub_RI[OF SCall.prems(1)] SCall.prems(4) by simp
let ?A⇩1 = "A ⊔ 𝒜s es"
let ?τ = "ty⇩i' ST E A"
let ?τs⇩e⇩s = "compTs E A ST es"
let ?τ⇩1 = "ty⇩i' (rev Ts' @ ST) E ?A⇩1"
let ?τ' = "ty⇩i' (T # ST) E ?A⇩1"
have "⊢ [Invokestatic C M (size es)],[] [::] [?τ⇩1,?τ']"
by(rule wt_Invokestatic[OF mxs same_size nclinit "method" subs])
also
have "PROP ?Ps es E Ts' A ST" by fact
hence "⊢ compEs⇩2 es,compxEs⇩2 es 0 (size ST) [::] ?τ # ?τs⇩e⇩s"
"last (?τ # ?τs⇩e⇩s) = ?τ⇩1"
using SCall.prems wtes by(auto simp add:after_def)
also have "(?τ # ?τs⇩e⇩s) @ [?τ'] = ?τ # ?τs⇩e⇩s @ [?τ']" by simp
finally show ?case using SCall.prems wtes by(simp add:after_def hyperUn_assoc)
next
case Seq thus ?case
by(auto simp:after_def)
(fastforce simp:wt_Push wt_Pop hyperUn_assoc
intro:wt_instrs_app2 wt_instrs_Cons)
next
case (INIT C Cs b e)
have "P,E ⊢⇩1 INIT C (Cs,b) ← e :: T" by fact
thus ?case using WT⇩1_nsub_RI by simp
next
case (RI C e' Cs e)
have "P,E ⊢⇩1 RI (C,e') ; Cs ← e :: T" by fact
thus ?case using WT⇩1_nsub_RI by simp
qed
lemma [simp]: "types (compP f P) = types P"
by auto
lemma [simp]: "states (compP f P) mxs mxl = states P mxs mxl"
by (simp add: JVM_states_unfold)
lemma [simp]: "app⇩i (i, compP f P, pc, mpc, T, τ) = app⇩i (i, P, pc, mpc, T, τ)"
apply (cases τ)
apply (cases i)
apply auto
apply (fastforce dest!: sees_method_compPD)
apply (force dest: sees_method_compP)
apply (force dest!: sees_method_compPD)
apply (force dest: sees_method_compP)
done
lemma [simp]: "is_relevant_entry (compP f P) i = is_relevant_entry P i"
apply (rule ext)+
apply (unfold is_relevant_entry_def)
apply (cases i)
apply auto
done
lemma [simp]: "relevant_entries (compP f P) i pc xt = relevant_entries P i pc xt"
by (simp add: relevant_entries_def)
lemma [simp]: "app i (compP f P) mpc T pc mxl xt τ = app i P mpc T pc mxl xt τ"
apply (simp add: app_def xcpt_app_def eff_def xcpt_eff_def norm_eff_def)
apply (fastforce simp add: image_def)
done
lemma [simp]: "app i P mpc T pc mxl xt τ ⟹ eff i (compP f P) pc xt τ = eff i P pc xt τ"
apply (clarsimp simp add: eff_def norm_eff_def xcpt_eff_def app_def)
apply (cases i)
apply auto
done
lemma [simp]: "subtype (compP f P) = subtype P"
apply (rule ext)+
apply (simp)
done
lemma [simp]: "compP f P ⊢ τ ≤' τ' = P ⊢ τ ≤' τ'"
by (simp add: sup_state_opt_def sup_state_def sup_ty_opt_def)
lemma [simp]: "compP f P,T,mpc,mxl,xt ⊢ i,pc :: τs = P,T,mpc,mxl,xt ⊢ i,pc :: τs"
by (simp add: wt_instr_def cong: conj_cong)
declare TC1.compT_sizes[simp] TC0.ty_def2[simp]
context TC2
begin
lemma compT_method_NonStatic:
fixes e and A and C and Ts and mxl⇩0
defines [simp]: "E ≡ Class C # Ts"
and [simp]: "A ≡ ⌊{..size Ts}⌋"
and [simp]: "A' ≡ A ⊔ 𝒜 e"
and [simp]: "mxl⇩0 ≡ max_vars e"
assumes mxs: "max_stack e = mxs"
and mxl: "Suc (length Ts + max_vars e) = mxl"
assumes assm: "wf_prog p P" "P,E ⊢⇩1 e :: T" "𝒟 e A" "ℬ e (size E)"
"set E ⊆ types P" "P ⊢ T ≤ T⇩r"
shows "wt_method (compP⇩2 P) C NonStatic Ts T⇩r mxs mxl⇩0 (compE⇩2 e @ [Return])
(compxE⇩2 e 0 0) (ty⇩i' [] E A # compT⇩a E A [] e)"
using assms apply (simp add: wt_method_def compT⇩a_def after_def mxl)
apply (rule conjI)
apply (simp add: check_types_def OK_ty⇩i'_in_statesI)
apply (rule conjI)
apply (drule (1) WT⇩1_is_type)
apply simp
apply (insert max_stack1 [where e=e])
apply (rule OK_ty⇩i'_in_statesI) apply (simp_all add: mxs)[3]
apply (erule compT_states(1))
apply assumption
apply (simp_all add: mxs mxl)[4]
apply (rule conjI)
apply (auto simp add: wt_start_def ty⇩i'_def ty⇩l_def list_all2_conv_all_nth
nth_Cons mxl split: nat.split dest: less_antisym)[1]
apply (frule (1) TC2.compT_wt_instrs [of P _ _ _ _ "[]" "max_stack e" "Suc (length Ts + max_vars e)" T⇩r])
apply simp_all
apply (clarsimp simp: after_def)
apply hypsubst_thin
apply (rule conjI)
apply (clarsimp simp: wt_instrs_def after_def mxl mxs)
apply clarsimp
apply (drule (1) less_antisym)
apply (clarsimp simp: wt_defs xcpt_app_pcs xcpt_eff_pcs ty⇩i'_def)
done
lemma compT_method_Static:
fixes e and A and C and Ts and mxl⇩0
defines [simp]: "E ≡ Ts"
and [simp]: "A ≡ ⌊{..<size Ts}⌋"
and [simp]: "A' ≡ A ⊔ 𝒜 e"
and [simp]: "mxl⇩0 ≡ max_vars e"
assumes mxs: "max_stack e = mxs"
and mxl: "length Ts + max_vars e = mxl"
assumes assm: "wf_prog p P" "P,E ⊢⇩1 e :: T" "𝒟 e A" "ℬ e (size E)"
"set E ⊆ types P" "P ⊢ T ≤ T⇩r"
shows "wt_method (compP⇩2 P) C Static Ts T⇩r mxs mxl⇩0 (compE⇩2 e @ [Return])
(compxE⇩2 e 0 0) (ty⇩i' [] E A # compT⇩a E A [] e)"
using assms apply (simp add: wt_method_def compT⇩a_def after_def mxl)
apply (rule conjI)
apply (simp add: check_types_def OK_ty⇩i'_in_statesI)
apply (rule conjI)
apply (drule (1) WT⇩1_is_type)
apply simp
apply (insert max_stack1 [where e=e])
apply (rule OK_ty⇩i'_in_statesI) apply (simp_all add: mxs)[3]
apply (erule compT_states(1))
apply assumption
apply (simp_all add: mxs mxl)[4]
apply (rule conjI)
apply (auto simp add: wt_start_def ty⇩i'_def ty⇩l_def list_all2_conv_all_nth
nth_Cons mxl split: nat.split dest: less_antisym)[1]
apply (frule (1) TC2.compT_wt_instrs [of P _ _ _ _ "[]" "max_stack e" "length Ts + max_vars e" T⇩r])
apply simp_all
apply (clarsimp simp: after_def)
apply hypsubst_thin
apply (rule conjI)
apply (clarsimp simp: wt_instrs_def after_def mxl mxs)
apply clarsimp
apply (drule (1) less_antisym)
apply (clarsimp simp: wt_defs xcpt_app_pcs xcpt_eff_pcs ty⇩i'_def)
done
end
definition compTP :: "J⇩1_prog ⇒ ty⇩P" where
"compTP P C M = (
let (D,b,Ts,T,e) = method P C M;
E = case b of Static ⇒ Ts | NonStatic ⇒ Class C # Ts;
A = case b of Static ⇒ ⌊{..<size Ts}⌋ | NonStatic ⇒ ⌊{..size Ts}⌋;
mxl = (case b of Static ⇒ 0 | NonStatic ⇒ 1) + size Ts + max_vars e
in (TC0.ty⇩i' mxl [] E A # TC1.compT⇩a P mxl E A [] e))"
theorem wt_compP⇩2:
"wf_J⇩1_prog P ⟹ wf_jvm_prog (compP⇩2 P)"
apply (simp add: wf_jvm_prog_def wf_jvm_prog_phi_def)
apply(rule_tac x = "compTP P" in exI)
apply (rule wf_prog_compPI)
prefer 2 apply assumption
apply (simp add: compTP_def) apply(rename_tac C M b Ts T m)
apply(case_tac b)
apply (clarsimp simp add: wf_mdecl_def)
apply (rule TC2.compT_method_Static [simplified])
apply (rule refl)
apply (rule refl)
apply assumption
apply assumption
apply assumption
apply assumption
apply (drule (1) sees_wf_mdecl)
apply (simp add: wf_mdecl_def)
apply (blast intro: sees_method_is_class)
apply assumption
apply (clarsimp simp add: wf_mdecl_def)
apply (rule TC2.compT_method_NonStatic [simplified])
apply (rule refl)
apply (rule refl)
apply assumption
apply assumption
apply assumption
apply assumption
apply (drule (1) sees_wf_mdecl)
apply (simp add: wf_mdecl_def)
apply (blast intro: sees_method_is_class)
apply assumption
done
theorem wt_J2JVM:
"wf_J_prog P ⟹ wf_jvm_prog (J2JVM P)"
apply(simp only:o_def J2JVM_def)
apply(blast intro:wt_compP⇩2 compP⇩1_pres_wf)
done
end